Hallo liebe Comunity,
Ich habe mehrere Excel-Tabellen in welchen ich Fotos und Informationen dieser Speichern möchte.
Dabei hat jede Tabelle mehrere Fotos. Die Infos der Fotos sind im Namen dieser verpackt und werden recht einfach über ein paar String spielereien zerstückelt und eingespeichert.
Soweit so schön. Jetzt möchte ich aber von einem Externen Dokument alle Excel-Tabellen (.xlsx Dateien) öffnen und diese wiederum sollen sich die Fotos "raussuchen" und deren Informationen Verarbeiten.
Klingt alles ziemlich komisch, ist aber bestimmt realisierbar.
In meinem Externen Excel-Dokument habe ich mit Makros und VBA ein Sub geschrieben mit welchem ich die ExcelTabellen nacheinander öffnen kann. Dafür benutze ich die Dir([pfad][dateityp]) - Funktion in kombination mit einer Do While schleife. Am ende ruf ich Dir() auf um zum nächsten Excel-Dokument weiter zu gehen. Jetzt kommt aber das Problem auf dass ich in dieser Do While Schleife ein weiteren Sub aufrufe, der mir die Fotos und deren Infos in meine aktuell geöffnete (aufgerufen und geöffnet über Dir([pfad][dateityp]) - Funktion) Excel Tabelle importiert. Dabei benutze ich aber auch die Dir([pfad][dateityp]) - Funktion, die alle Bilder durchgeht und die gewünschten einfügt.
Ist mein Sub fertig, geht es in meiner Do-While-Schleife weiter und zuletzt wird wieder Dir() Befehl aufgerufen um zur nächsten Excel-Datei zu springen. Das passiert aber nicht, da sich die Funktion an die zuletzt geschriebene Dir([pfad][dateityp]) - Funktion anpasst. Und damit ist nicht mehr der Pfad der Excel-Tabellen wichtig, sondern der der Bilder und mein Programm wirft eine Fehlermeldung.
Wie kann ich nun 2 Dir()-Funktionen verschachteln?
Im übrigen, die ExcelDokumente nacheinander aufzurufen Funktioniert und das Makro/Sub für die Foto importierung funktioniert auch, wenn ich es aus einer der ExcelDokumente aus starte.
Ich hab den Code mal hier rein gepackt. Grober Aufbau:
Sub1
Dir1() pfad der ExcelDat
Do-While start
Sub2 wird aufgerufen
Dir2() pfad der Fotos
Do-While start
Dir2() soll zum nächsten Foto gehen
Do-While ende
sub2 ende
Dir1() soll zum nächsten Exel gehen
Do-While ende
Sub1 ende
Sub ExcelDatAufrufen()
Dim strFile As String
strPath = "C:\Users\Toni\Desktop\Bearbeitung\"
strExt = "*.xlsx*"
If strPath = "" Then
Exit Sub
Else
strFile = Dir(strPath & strExt)
Do While Len(strFile) > 0
Workbooks.Open Filename:=strPath & strFile
'
Sheets("Seite1").Select
MakroFotosEinfügen
ActiveWorkbook.Save
Workbooks(strFile).Close False ' Arbeitsmappe wird geschlossen
strFile = Dir() ' nächste Datei wird ermittelt
Loop
End If
End Sub
Sub MakroFotosEinfügen()
'
Dim myName As String
Dim bez As String
Dim nr As String
myName = ActiveWorkbook.FullName
namear = Split(myName, "\")
bez = namear(UBound(namear))
nrs = Split(bez, "_")
nr = nrs(1)
Sheets("Seite1").Select
Dim arr
srcPath = ActiveWorkbook.Path & "\" '& nr
MsgBox (srcPath)
If srcPath = "" Then
Exit Sub
Else
strBild = Dir(srcPath & "*.JPG")
If strBild = "" Then
Exit Sub
End If
Do While Len(strBild) > 0
Sheets("Seite1").Select
strBild = Left(strBild, Len(strBild) - 4)
If strBild = "" Then
MsgBox ("Achtung ERROR")
Else
arr = Split(strBild, " ")
End If
strNr = arr(0)
strPos = arr(1)
strZust = arr(2)
strKom = arr(3)
If UBound(arr) < 4 Then
strOrt = "-:-"
Else
strOrt = arr(4)
End If
Dim cell As Range
Dim actrow As Integer
For Each cell In Range("A15", "A56").Cells
strV = cell.Value
If StrComp(strV, strPos) = 0 Then
actrow = cell.Row
cell.Offset(0, 6) = ""
If StrComp(strZust, "A") = 0 Then
cell.Value = "X"
ElseIf StrComp(strZust, "B") = 0 Then
cell.Offset(0, 7) = "X"
ElseIf StrComp(strZust, "C") = 0 Then
cell.Offset(0, 8) = "X"
ElseIf StrComp(strZust, "D") = 0 Then
cell.Offset(0, 9) = "X"
End If
cell.Offset(0, 14) = strKom
End If
Next cell
Sheets("Seite2").Select
For Each cell In Range("A9", "A14").Cells
strV = cell.Value
If StrComp(strV, strPos) = 0 Then
'MsgBox ("verschiebung bei " & strV & "," & cell.Row)
cell.Offset(0, 1) = strOrt
End If
Next cell
strBild = Dir()
Loop
End If
End Sub
Ich habe mehrere Excel-Tabellen in welchen ich Fotos und Informationen dieser Speichern möchte.
Dabei hat jede Tabelle mehrere Fotos. Die Infos der Fotos sind im Namen dieser verpackt und werden recht einfach über ein paar String spielereien zerstückelt und eingespeichert.
Soweit so schön. Jetzt möchte ich aber von einem Externen Dokument alle Excel-Tabellen (.xlsx Dateien) öffnen und diese wiederum sollen sich die Fotos "raussuchen" und deren Informationen Verarbeiten.
Klingt alles ziemlich komisch, ist aber bestimmt realisierbar.
In meinem Externen Excel-Dokument habe ich mit Makros und VBA ein Sub geschrieben mit welchem ich die ExcelTabellen nacheinander öffnen kann. Dafür benutze ich die Dir([pfad][dateityp]) - Funktion in kombination mit einer Do While schleife. Am ende ruf ich Dir() auf um zum nächsten Excel-Dokument weiter zu gehen. Jetzt kommt aber das Problem auf dass ich in dieser Do While Schleife ein weiteren Sub aufrufe, der mir die Fotos und deren Infos in meine aktuell geöffnete (aufgerufen und geöffnet über Dir([pfad][dateityp]) - Funktion) Excel Tabelle importiert. Dabei benutze ich aber auch die Dir([pfad][dateityp]) - Funktion, die alle Bilder durchgeht und die gewünschten einfügt.
Ist mein Sub fertig, geht es in meiner Do-While-Schleife weiter und zuletzt wird wieder Dir() Befehl aufgerufen um zur nächsten Excel-Datei zu springen. Das passiert aber nicht, da sich die Funktion an die zuletzt geschriebene Dir([pfad][dateityp]) - Funktion anpasst. Und damit ist nicht mehr der Pfad der Excel-Tabellen wichtig, sondern der der Bilder und mein Programm wirft eine Fehlermeldung.
Wie kann ich nun 2 Dir()-Funktionen verschachteln?
Im übrigen, die ExcelDokumente nacheinander aufzurufen Funktioniert und das Makro/Sub für die Foto importierung funktioniert auch, wenn ich es aus einer der ExcelDokumente aus starte.
Ich hab den Code mal hier rein gepackt. Grober Aufbau:
Sub1
Dir1() pfad der ExcelDat
Do-While start
Sub2 wird aufgerufen
Dir2() pfad der Fotos
Do-While start
Dir2() soll zum nächsten Foto gehen
Do-While ende
sub2 ende
Dir1() soll zum nächsten Exel gehen
Do-While ende
Sub1 ende
Sub ExcelDatAufrufen()
Dim strFile As String
strPath = "C:\Users\Toni\Desktop\Bearbeitung\"
strExt = "*.xlsx*"
If strPath = "" Then
Exit Sub
Else
strFile = Dir(strPath & strExt)
Do While Len(strFile) > 0
Workbooks.Open Filename:=strPath & strFile
'
Sheets("Seite1").Select
MakroFotosEinfügen
ActiveWorkbook.Save
Workbooks(strFile).Close False ' Arbeitsmappe wird geschlossen
strFile = Dir() ' nächste Datei wird ermittelt
Loop
End If
End Sub
Sub MakroFotosEinfügen()
'
Dim myName As String
Dim bez As String
Dim nr As String
myName = ActiveWorkbook.FullName
namear = Split(myName, "\")
bez = namear(UBound(namear))
nrs = Split(bez, "_")
nr = nrs(1)
Sheets("Seite1").Select
Dim arr
srcPath = ActiveWorkbook.Path & "\" '& nr
MsgBox (srcPath)
If srcPath = "" Then
Exit Sub
Else
strBild = Dir(srcPath & "*.JPG")
If strBild = "" Then
Exit Sub
End If
Do While Len(strBild) > 0
Sheets("Seite1").Select
strBild = Left(strBild, Len(strBild) - 4)
If strBild = "" Then
MsgBox ("Achtung ERROR")
Else
arr = Split(strBild, " ")
End If
strNr = arr(0)
strPos = arr(1)
strZust = arr(2)
strKom = arr(3)
If UBound(arr) < 4 Then
strOrt = "-:-"
Else
strOrt = arr(4)
End If
Dim cell As Range
Dim actrow As Integer
For Each cell In Range("A15", "A56").Cells
strV = cell.Value
If StrComp(strV, strPos) = 0 Then
actrow = cell.Row
cell.Offset(0, 6) = ""
If StrComp(strZust, "A") = 0 Then
cell.Value = "X"
ElseIf StrComp(strZust, "B") = 0 Then
cell.Offset(0, 7) = "X"
ElseIf StrComp(strZust, "C") = 0 Then
cell.Offset(0, 8) = "X"
ElseIf StrComp(strZust, "D") = 0 Then
cell.Offset(0, 9) = "X"
End If
cell.Offset(0, 14) = strKom
End If
Next cell
Sheets("Seite2").Select
For Each cell In Range("A9", "A14").Cells
strV = cell.Value
If StrComp(strV, strPos) = 0 Then
'MsgBox ("verschiebung bei " & strV & "," & cell.Row)
cell.Offset(0, 1) = strOrt
End If
Next cell
strBild = Dir()
Loop
End If
End Sub
