Auf Thema antworten 2026

Beitrag

<blockquote data-quote="Tonl" data-source="post: 2668608" data-attributes="member: 593309">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 &quot;raussuchen&quot; 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:Sub1Dir1()&nbsp; &nbsp; &nbsp; &nbsp;&nbsp; pfad der ExcelDatDo-While&nbsp; &nbsp; startSub2&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; wird aufgerufenDir2()&nbsp; &nbsp; &nbsp; &nbsp;&nbsp; pfad der FotosDo-While&nbsp; &nbsp; startDir2()&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; soll zum nächsten Foto gehenDo-While&nbsp; &nbsp; endesub2&nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; endeDir1()&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; soll zum nächsten Exel gehenDo-While&nbsp; &nbsp; endeSub1&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; endeSub ExcelDatAufrufen()Dim strFile As String&nbsp; &nbsp; strPath = &quot;C:\Users\Toni\Desktop\Bearbeitung\&quot;&nbsp; &nbsp; &nbsp; &nbsp; strExt = &quot;*.xlsx*&quot;&nbsp; &nbsp; If strPath = &quot;&quot; Then&nbsp; &nbsp; &nbsp; &nbsp; Exit Sub&nbsp; &nbsp; Else&nbsp; &nbsp; &nbsp; &nbsp; strFile = Dir(strPath &amp; strExt)&nbsp; &nbsp; &nbsp; &nbsp; Do While Len(strFile) &gt; 0&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Workbooks.Open Filename:=strPath &amp; strFile&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &#039;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Sheets(&quot;Seite1&quot;).Select&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; MakroFotosEinfügen&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ActiveWorkbook.Save&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Workbooks(strFile).Close False&nbsp; &#039; Arbeitsmappe wird geschlossen&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; strFile = Dir()&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; &#039; nächste Datei wird ermittelt&nbsp; &nbsp; &nbsp; &nbsp; Loop&nbsp; &nbsp; End IfEnd SubSub MakroFotosEinfügen()&#039;Dim myName As StringDim bez As StringDim nr As StringmyName = ActiveWorkbook.FullNamenamear = Split(myName, &quot;\&quot;)bez = namear(UBound(namear))nrs = Split(bez, &quot;_&quot;)nr = nrs(1)Sheets(&quot;Seite1&quot;).SelectDim arrsrcPath = ActiveWorkbook.Path &amp; &quot;\&quot; &#039;&amp; nrMsgBox (srcPath)If srcPath = &quot;&quot; Then&nbsp; &nbsp; Exit SubElse&nbsp;&nbsp; strBild = Dir(srcPath &amp; &quot;*.JPG&quot;)&nbsp; &nbsp; If strBild = &quot;&quot; Then&nbsp; &nbsp; Exit Sub&nbsp; &nbsp; End If&nbsp; &nbsp; &nbsp;&nbsp; &nbsp; &nbsp; Do While Len(strBild) &gt; 0&nbsp; &nbsp; Sheets(&quot;Seite1&quot;).Select&nbsp; &nbsp; strBild = Left(strBild, Len(strBild) - 4)&nbsp; &nbsp; If strBild = &quot;&quot; Then&nbsp; &nbsp; &nbsp; &nbsp; MsgBox (&quot;Achtung ERROR&quot;)&nbsp; &nbsp; Else&nbsp; &nbsp; &nbsp; &nbsp; arr = Split(strBild, &quot; &quot;)&nbsp; &nbsp; End If&nbsp; &nbsp; strNr = arr(0)&nbsp; &nbsp; strPos = arr(1)&nbsp; &nbsp; strZust = arr(2)&nbsp; &nbsp; strKom = arr(3)&nbsp; &nbsp; If UBound(arr) &lt; 4 Then&nbsp; &nbsp; strOrt = &quot;-:-&quot;&nbsp; &nbsp; Else&nbsp; &nbsp; strOrt = arr(4)&nbsp; &nbsp; End If&nbsp;&nbsp; &nbsp; &nbsp; Dim cell As Range&nbsp; &nbsp; Dim actrow As Integer&nbsp;&nbsp; &nbsp; &nbsp; For Each cell In Range(&quot;A15&quot;, &quot;A56&quot;).Cells&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; &nbsp; &nbsp; &nbsp;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; strV = cell.Value&nbsp; &nbsp; &nbsp;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If StrComp(strV, strPos) = 0 Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; actrow = cell.Row&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; cell.Offset(0, 6) = &quot;&quot;&nbsp; &nbsp; &nbsp;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If StrComp(strZust, &quot;A&quot;) = 0 Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; cell.Value = &quot;X&quot;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ElseIf StrComp(strZust, &quot;B&quot;) = 0 Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; cell.Offset(0, 7) = &quot;X&quot;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ElseIf StrComp(strZust, &quot;C&quot;) = 0 Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; cell.Offset(0, 8) = &quot;X&quot;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ElseIf StrComp(strZust, &quot;D&quot;) = 0 Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; cell.Offset(0, 9) = &quot;X&quot;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; cell.Offset(0, 14) = strKom&nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; Next cell&nbsp;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Sheets(&quot;Seite2&quot;).Select&nbsp; &nbsp; &nbsp;&nbsp; &nbsp; &nbsp; For Each cell In Range(&quot;A9&quot;, &quot;A14&quot;).Cells&nbsp; &nbsp; &nbsp;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; strV = cell.Value&nbsp; &nbsp; &nbsp; &nbsp; If StrComp(strV, strPos) = 0 Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &#039;MsgBox (&quot;verschiebung bei &quot; &amp; strV &amp; &quot;,&quot; &amp; cell.Row)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; cell.Offset(0, 1) = strOrt&nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; Next cell&nbsp; &nbsp; strBild = Dir()&nbsp; &nbsp; Loop&nbsp; &nbsp; End IfEnd Sub</blockquote>

[QUOTE="Tonl, post: 2668608, member: 593309"] 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 [I]Sub ExcelDatAufrufen() Dim strFile As String strPath = "C:\Users\Toni\Desktop\Bearbeitung\" strExt = "*.xlsx*" If strPath = "" Then Exit Sub Else [B]strFile = Dir(strPath & strExt)[/B] Do While Len(strFile) > 0 Workbooks.Open Filename:=strPath & strFile ' Sheets("Seite1").Select MakroFotosEinfügen ActiveWorkbook.Save Workbooks(strFile).Close False ' Arbeitsmappe wird geschlossen [B]strFile = Dir() ' nächste Datei wird ermittelt[/B] 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 [B] strBild = Dir(srcPath & "*.JPG")[/B] 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 [B]strBild = Dir()[/B] Loop End If End Sub[/I] [/QUOTE]

Bilder bitte hier hochladen und danach über das Bild-Icon (Direktlink vorher kopieren) platzieren.

Authentifizierung

Wenn ▲ = 5, ▼ = 2 und ■ = 7, was ist ▲ × ▼ + ■?