Teil 2)
01.01.2016 13:40:25
ransi
Hallo Stefan,
...es muß ein Ausgleich geschaffen werden!
Schließ mich in dein Nachtgebet mit ein und Alles ist gut...;-)
Teste mal dies:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Const Pfad_Zahlungen As String = "E:\Zahlungen\"
Const Pfad_Rechnungen As String = "E:\Rechnungen\"
Sub Aufruf()
Call Emons
Call Rechnungen
End Sub
Sub Emons()
Dim Bereich As Range, Zelle As Range
Dim Regex As Object, objM As Object
Set Regex = CreateObject("Vbscript.Regexp")
With Sheets("2016")
Set Bereich = Intersect(.Range("I1").CurrentRegion, .Range("I:I")) 'in einer Zelle der Spalte I
With Regex
.Pattern = "(Emons).+(240\d+)" 'Dann soll das Programm über den Text "240" die Rechnungsnummer 240563355 erkennen
.Global = False
For Each Zelle In Bereich
If .Test(Zelle.Text) = True Then
Set objM = .Execute(Zelle.Text)
' MsgBox objM(0).Value
SchreibMwSt Zelle.Offset(0, -3)
schreib_Hyperlink Zelle.Offset(0, 1), Pfad_Zahlungen & objM(0).submatches(1) & ".pdf"
End If
Next
End With
End With
End Sub
Sub Rechnungen()
Dim Bereich As Range, Zelle As Range
Dim Regex As Object, objM As Object
Set Regex = CreateObject("Vbscript.Regexp")
With Sheets("2016")
Set Bereich = Intersect(.Range("I1").CurrentRegion, .Range("I:I")) 'in einer Zelle der Spalte I
With Regex
.Pattern = "(2015|2016)\-(\d{3,4})(?=\D)" '"2015-" oder "2016-" erkannt werden. Nach der Kennung folgt eine 3stellige, bald 4stellige Zahl,
.Global = False
For Each Zelle In Bereich
If .Test(Zelle.Text) = True Then
Set objM = .Execute(Zelle.Text)
MsgBox "Treffer " & objM(0).submatches(1)
schreib_Hyperlink Zelle.Offset(0, 1), Pfad_Rechnungen & objM(0).submatches(1) & ".pdf"
schreib_F45 Zelle.Offset(0, -4), "='" & Pfad_Rechnungen & "[Formularrechnung" & objM(0).submatches(1) & ".xlsm]Tabelle1'!$F$45"
End If
Next
End With
End With
End Sub
Sub SchreibMwSt(Ziel As Range)
Ziel.Value = 0.19 'so soll in der Spalte E der Wert 0,19 stehen.
End Sub
Sub schreib_Hyperlink(Ziel As Range, Linkadresse As String)
Sheets("2016").Hyperlinks.Add Anchor:=Ziel, Address:=Linkadresse 'die Datei 240563355.pdf im Verzeichnis E:/Zahlungen als Hperlink in der Spalte J setzen.
End Sub
Sub schreib_F45(Ziel As Range, Formel As String)
With Ziel
.FormulaLocal = Formel
.Value = .Value
End With
End Sub
ICh hoffe ich habs richtig verstanden.
In deiner Beschreibing hast du meherere Pfade unter E: und mehrere Formularrechnung* erwähnt.
ransi