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

[Flex123]

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]

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]

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]

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]

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]

Kann mir keiner helfen?

Gruß

 

[tombe]

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]

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]

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]

Danke. Klappt alles.

Gruß