# [Excel] Bilder in Arbeitsmappe einfürgen durch Abgleich der Warennummer



## Flex123 (16. März 2010)

Hallo, 

ich bin in Sachen VBA noch ein totaler Anfänger, deswegen bräuchte ich mal eure Hilfe. 

Ich hab 2 Excelmappen. Die erste Mappe ist sozusagen ein Konfigurator, wo ich in der Zelle A15 die Warennummer eingebe. Jetzt soll er mir aus einem Ordner die dazugehörigen Bilder in die 2te Excelmappe einfügen. Falls mehrere Bilder Vorhanden sind, soll er mir sie untereinander einfügen.. 
Der Dateiname der Bilder soll unter den Bildern eingefügt werden.
Der Dateiname der Bilder fängt mit der 10stelligen Warennummer an und geht dann mit der Bezeichnung weiter. 

Ich hab hier schon mal einen Ansatz komm jetzt aber nicht wirklich weiter. 

Danke schon mal für eure Hilfe! 

Sub DateienSuchen()
   Dim arr As Variant
   Dim iCounter As Integer, iFile As Integer
   arr = Array(Zelle & "_" & "var_bildzaehler" & "*.gif", Zelle & "_" & " var_bildzaehler" & "*.jpg")
   For iCounter = LBound(arr) To UBound(arr)
      With Application.FileSearch
         .NewSearch
         .LookIn = "P:\Bilder"
         .Filename = arr(iCounter)
         .MatchTextExactly = True
         .SearchSubFolders = False
         .Execute


         For iFile = 1 To .FoundFiles.Count
            Cells(iFile, 1).Value = .FoundFiles(iFile)



         Next iFile
      End With
   Next iCounter
End Sub


----------



## Flex123 (17. März 2010)

Kann mir keiner helfen?


----------



## tombe (17. März 2010)

Ich denke mal das das Problem das Array "arr" ist bzw. wie du hier die Dateinamen bildest.

Lass dir mal den Inhalt des Arrays am Bildschirm oder sonst wo ausgeben und vergleiche mal ob es das auch wirklich sein soll.

Gruß Thomas

NACHTRAG:

So sofern ich das mit den Dateinamen richtig verstanden habe, sollte es so funktionieren:


```
Dim iCounter As Integer, iFile As Integer
Dim zeile As Integer
Zelle = Range("A15")
'Suche für JPG Dateien
With Application.FileSearch
    .NewSearch
    .LookIn = "P:\Bilder"
    .Filename = Zelle & "*.jpg"
    .SearchSubFolders = False
    .Execute
    For iFile = 1 To .FoundFiles.Count
        Cells(iFile, 1).Value = .FoundFiles(iFile)
    Next iFile
    
    zeile = .FoundFiles.Count
End With
'Suche für GIF Dateien
With Application.FileSearch
    .NewSearch
    .LookIn = "P:\Bilder"
    .Filename = Zelle & "*.gif"
    .SearchSubFolders = False
    .Execute
    For iFile = 1 To .FoundFiles.Count
        Cells(iFile + zeile, 1).Value = .FoundFiles(iFile)
    Next iFile
End With
```


----------



## Flex123 (18. März 2010)

Hi, 

danke, dass klappt schon mal ganz gut.

Jetzt hab ich nur folgendes Problem: 

Er zeigt den Pfad in der gleichen Arbeitsmappe an, dass soll er ja nicht. Er soll die Bilder in der 2ten Arbeitsmappe einfügen, und dann darunter den Dateinamen anzeigen. 
Vielleicht hast du dazu auch eine Idee, ich komm da nämlich nicht weiter.

Danke schon mal im 

Gruß
Flex


----------



## tombe (18. März 2010)

Also wenn du von Arbeitsmappe redest verstehe ich das so das es in der Excel Datei eine "Tabelle 1" und eine "Tabelle 2" gibt. In "Tabelle 1" gibst du die Warennummer ein und in "Tabelle 2" sollen die Daten angezeigt werden!!

Dann ändere einfach die Zeile:


```
Cells(iFile + zeile, 1).Value = .FoundFiles(iFile)
```

so ab:


```
Tabelle2.Cells(iFile + zeile, 1).Value = .FoundFiles(iFile)
```

Gruß Thomas


----------



## Flex123 (18. März 2010)

Danke,
das hilft mir schon mal sehr viel weiter!

Aber kann VBA auch anstatt der Pfadangabe die Bilder einfügen und dadrunter den Dateinamen setzten. 

Gruß


----------



## tombe (18. März 2010)

Schau mal ob du damit weiterkommst:


```
For anzahl = 1 To Tabelle2.Range("A65536").End(xlUp).Row
    Tabelle2.Cells(Wiederholungen, 1).Activate
    Tabelle2.Pictures.Insert(Tabelle2.Cells(Wiederholungen, 1)).Select
Next
```

Oder schau mal hier: http://www.office-loesung.de/ftopic52795_0_0_asc.php da hat/hette jemand das gleiche Problem.


----------



## Flex123 (18. März 2010)

Danke für die schnelle Hilfe.

Ich werd es damit erst einmal versuchen.

Gruß
Flex


----------



## Flex123 (18. März 2010)

Hi,

ist egal wie ich es versuche die Formel einzusetzten. Er zeigt mir immer einen Fehler an meisten 1004. Weißt du woran es liegen kann?

Der Link hilft mir leider nicht. Wenn ich es so umsetze passiert nichts.

Danke

Gruß


----------



## tombe (18. März 2010)

Ups, war wohl mein Fehler.
Im dem Makro gabe es eine komische Variable "Wiederholungen" die habe ich bei mir zum Testen so belassen und erst als ich es hier reinkpoiert habe geändert. Allerdings habe ich Trottel sie nur an einer Stelle umbenannt und die anderen 2 einfach so belassen.


```
For anzahl = 1 To Tabelle2.Range("A65536").End(xlUp).Row
    Tabelle2.Cells(anzahl, 1).Activate
    Tabelle2.Pictures.Insert(Tabelle2.Cells(anzahl, 1)).Select
Next
```

Ändere es mal so wie oben ab, dann läuft es. Habe es bei mir gerade probiert der Fehler 1004 entsteht dadurch.

Sorry Thomas


----------



## Flex123 (18. März 2010)

Danke für deine schnelle Antwort.

Der meckert bei mir das der den Activate- Methode des Range- Objektes konnte nicht ausgeführt werden.

Hier der Code, habe auch andere Varianten Probiert:

Sub DateienSuchen()

Dim iCounter As Integer, iFile As Integer
Dim zeile As Integer
Dim anzahl As Integer
Zelle = Range("A15")

'Suche für JPG Dateien
With Application.FileSearch
    .NewSearch
    .LookIn = "P:\Bilder"
    .Filename = Zelle & "*.jpg"
    .SearchSubFolders = False
    .Execute

For anzahl = 1 To Tabelle2.Range("A65536").End(xlUp).Row
    Tabelle2.Cells(anzahl, 1).Activate
    Tabelle2.Pictures.Insert(Tabelle2.Cells(anzahl, 1)).Select
Next

    zeile = .FoundFiles.Count

End With

'Suche für GIF Dateien
With Application.FileSearch
    .NewSearch
    .LookIn = "P:\Bilder"
    .Filename = Zelle & "*.gif"
    .SearchSubFolders = False
    .Execute

For anzahl = 1 To Tabelle2.Range("A65536").End(xlUp).Row
    Tabelle2.Cells(anzahl, 1).Activate
    Tabelle2.Pictures.Insert(Tabelle2.Cells(anzahl, 1)).Select
Next

End With
End Sub


----------



## tombe (18. März 2010)

Heißt bei dir die entsprechende Tabelle auch "Tabelle2" ?

Und nimm mal den Teil:


```
For anzahl = 1 To Tabelle2.Range("A65536").End(xlUp).Row
Tabelle2.Cells(anzahl, 1).Activate
Tabelle2.Pictures.Insert(Tabelle2.Cells(anzahl, 1)).Select
Next
```

da wo du ihn jetzt zweimal stehen hast komplett raus und füge ihn ganz am Ende (nach dem letzten "End With") einmal wieder ein !!


----------



## Flex123 (19. März 2010)

Hi,

hat sich leider nichts geändert. Wenn ich das im Modul packe kommt der besagt Fehler.
Wenn ich das in eine Arbeitsmappe packe dann kommt der Fehler 400.

Hast du vllt noch eine andere Idee?

Gruß


----------



## Flex123 (19. März 2010)

So das hab ich hinbekommen.  Die Spalten überlagerten sich.

Aber er fügt jetzt alle Bilder ein und auch über einander. Nicht nur die die gleiche Materialnummer haben.

Hm.. muss ich mal weiter dran basteln


----------



## Flex123 (6. April 2010)

Hallo,

Hab es nun zum laufen bekommen. habe nur eine Frage noch.

Was muss ich ändern wenn ich nicht nur aus A15 die Warennummern auslesen möchte sondern aus dem Bereich A15 bis A36

Kann mir einer helfen?

Modul 1:
Sub DateienSuchen1()

Dim iCounter As Integer, iFile As Integer
Dim zeile As Integer
Dim anzahl As Integer


Zelle = Range("A15")

'Suche für JPG Dateien
With Application.FileSearch
    .NewSearch
    .LookIn = "P:\Bilder"
    .Filename = Zelle & "*.jpg"
    .SearchSubFolders = False
    .Execute

    For iFile = 1 To .FoundFiles.Count
        Tabelle4.Cells(iFile + zeile, 1).Value = .FoundFiles(iFile) 
    Next iFile

    zeile = .FoundFiles.Count

End With

'Suche für GIF Dateien
With Application.FileSearch
    .NewSearch
    .LookIn = "P:\Bilder"
    .Filename = Zelle & "*.gif"
    .SearchSubFolders = False
    .Execute

    For iFile = 1 To .FoundFiles.Count
        Tabelle4.Cells(iFile + zeile, 1).Value = .FoundFiles(iFile) 
    Next iFile

    zeile = .FoundFiles.Count

End With
End Sub

Modul2:
Sub Bildereinfuegen2()
Dim anzahl As Integer

   For anzahl = 1 To Tabelle4.Range("A65536").End(xlUp).Row
    Tabelle4.Cells(anzahl, 1).Activate
    Tabelle4.Pictures.Insert(Tabelle4.Cells(anzahl, 1)).Select
   Next

End Sub

Danke!

Gruß


----------



## Flex123 (7. April 2010)

Kann mir keiner helfen?

Gruß


----------



## tombe (7. April 2010)

Nicht schön aber es scheint zu klappen:


```
Sub DateienSuchen1()
Dim iCounter As Integer, iFile As Integer
Dim zeile As Integer
Dim anzahl As Integer

For a% = 15 To 36

Zelle = Range("A" & a%)

'Suche für JPG Dateien
With Application.FileSearch
    .NewSearch
    .LookIn = "P:\Bilder"
    .Filename = Zelle & "*.jpg"
    .SearchSubFolders = False
    .Execute

    For iFile = 1 To .FoundFiles.Count
        Tabelle4.Cells(iFile + zeile, 1).Value = .FoundFiles(iFile)
    Next iFile

    zeile = .FoundFiles.Count
End With

'Suche für GIF Dateien
With Application.FileSearch
    .NewSearch
    .LookIn = "P:\Bilder"
    .Filename = Zelle & "*.gif"
    .SearchSubFolders = False
    .Execute

    For iFile = 1 To .FoundFiles.Count
        Tabelle4.Cells(iFile + zeile, 1).Value = .FoundFiles(iFile)
    Next iFile

    zeile = .FoundFiles.Count
End With
Next a%
End Sub
```


----------



## Flex123 (8. April 2010)

Danke. 

Hab funktioniert leider nicht. Nimmt die letzte Position an, also wenn For a% = 15 To 17 steht dann nimmt er die Zelle A17 und wenn For a% = 15 To 36 steht nimmt er die Zelle A36. Aber leider nicht den Bereich. 

Versuche da schon seit mehreren Tagen eine Lösung zu kreaieren, bis jetzt leider ohne Erfolg.

Hast du evtl. noch einen anderen Vorschlag?

Gruß


----------



## tombe (8. April 2010)

Es ist noch eine kleine Anpassung nötig, dann geht es. Ersetzte diese Zeilen:


```
zeile = .FoundFiles.Count
```

durch die folgende:


```
zeile = Tabelle5.Range("A65536").End(xlUp).Row
```

Zumindest wird dann der Bereich durchlaufen und in Tabelle 4 werden alle entsprechenden Dateinamen in Spalte A eingetragen.

Gruß Thomas


----------



## Flex123 (8. April 2010)

Danke. Klappt alles.

Gruß


----------

