VBA Excel Bilder einfügen

[King Bill]

Hi Leute, zur Notiz, mein Wissen über VBA ist direkt Null.

Also ich habe eine Tabelle mit weit über 1000 Zeilen, wo in jede ein Bild eingefügt werden muss.

Ich habe schon das passende Script gefunden. Excel-Inside Solutions - Bilder in Zellen importieren

Leider hört er bei Zeile 390 auf, wenn ich bei Zeile 2 starte. Also er arbeitet nur 389 Bilder ab und hört dann auf.

Nun weiß ich nicht was da limitiert. Wäre über jeden Ratschlag dankbar.

 

[McGizmo]

Hört er "stumm" auf oder gibt es irgendwelche Fehler? Immer bei 390? Irgendwas an Bild 391 im Verzeichnis verquer (vll. zum Test mal rausnehmen?)

 

[King Bill]

Schon getestet. Wenn ich die Startzeile ändere, werden auch nur 389 Bilder abgearbeitet, das gleiche wenn ich nur alle zwei Grafiken mache. An den Bildern kann es somit nicht liegen.

Ich denke irgendein Array ist dann voll. Aber frag mich mal was leichteres

 

[McGizmo]

Also ich muss gestehen ich hab was der gemacht hat nur so bedingt nachvollziehen können (also wie ers gemacht hat, zB das erste Bild rausziehen). Ich hab das mal ein bisschen "gefrankensteint", damit hab ich grad mal 604 Bilder erfolgreich importiert. Probier's ma ... hab auch das Update ausgeschaltet, heißt man sieht nix während erwas tut - dafür isses schneller ....

Sub BilderImportFrankenstein()


'*********************************************************************************
'** Bilder werden in die Spalte A eingefügt. Die Bilder werden auf die
'** eingestellte Spaltebreite skaliert. Die Zeilenhöhe wird an die
'** skalierte Bildhöhe angepasst
'*********************************************************************************


'* * Dimensionierung der Variablen
Dim strVerzeichnis$, strDatei$
Dim pct As Picture
Dim lngZeile As Long 'Zeile zum Eintragen der Bilder
Dim lngSpalte As Long 'Spalte zum Eintragen der Bilder
Dim varBreite As Variant 'Spaltenbreite
Dim varHoehe As Variant


Application.ScreenUpdating = False




'** Verzeichnis und Dateinamen definieren und auslesen
strVerzeichnis = "PFAD"
strDatei = Dir(strVerzeichnis & "\*.jpg")
Cells(1, 1) = strDatei


ctr = 1


ActiveSheet.Pictures.Delete
varBreite = Columns("A:A").Width


Do While strDatei <> ""
  Cells(ctr, 2) = strDatei
  Cells(ctr, 1).Select
  'Selection.Value = "Bla"
  ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei).Select
  Selection.ShapeRange.LockAspectRatio = msoTrue


  '** Bild auf aktuelle Spaltenbreite skalieren<
  Selection.ShapeRange.Width = varBreite


    '** Zeilenhöhe festlegen
  varHoehe = Selection.ShapeRange.Height
  Rows(ctr).RowHeight = varHoehe


  strDatei = Dir()
  ctr = ctr + 1
Loop


Application.ScreenUpdating = True




End Sub

 

[King Bill]

Es ist echt super schnell. Leider ist auch hier bei mir bis 389 Schluss.

 

[McGizmo]

Tja dann Tonne auf Rechner rein. Ist kaputt!

Hm. Keinen Plan das machts dann schwierig ... ist ja nicht so dass deine Kiste irgendwie schwach auf der Brust wäre, speichertechnisch oder so.

 

[King Bill]

Gizzle, welche Office Version verwendest du? Hab Office 2016. Nicht dass es daran liegt

 

[McGizmo]

Ich nutz' ebenfalls 2016.

Okay, hm. Lassen wir mal das Bilder einfügen weg und gucken ob das Skript einfach nur alle Bilder aufgelistet bekommt. Daher bitte mal folgendes, das sollte einfach nur die Dateinamen aller Bilder ein die zweite Spalte einfügen.

Sub BilderImportFrankenstein()


'*********************************************************************************
'** Bilder werden in die Spalte A eingefügt. Die Bilder werden auf die
'** eingestellte Spaltebreite skaliert. Die Zeilenhöhe wird an die
'** skalierte Bildhöhe angepasst
'*********************************************************************************


'* * Dimensionierung der Variablen
Dim strVerzeichnis$, strDatei$
Dim pct As Picture
Dim lngZeile As Long 'Zeile zum Eintragen der Bilder
Dim lngSpalte As Long 'Spalte zum Eintragen der Bilder
Dim varBreite As Variant 'Spaltenbreite
Dim varHoehe As Variant


'Application.ScreenUpdating = False




'** Verzeichnis und Dateinamen definieren und auslesen
strVerzeichnis = "PFAD"
strDatei = Dir(strVerzeichnis & "\*.jpg")
Cells(1, 1) = strDatei


ctr = 1


ActiveSheet.Pictures.Delete
varBreite = Columns("A:A").Width


Do While strDatei <> ""
  Cells(ctr, 2) = strDatei
  'Cells(ctr, 1).Select
  'ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei).Select
  'Selection.ShapeRange.LockAspectRatio = msoTrue


  '** Bild auf aktuelle Spaltenbreite skalieren<
  'Selection.ShapeRange.Width = varBreite


    '** Zeilenhöhe festlegen
  'varHoehe = Selection.ShapeRange.Height
  'Rows(ctr).RowHeight = varHoehe


  strDatei = Dir()
  ctr = ctr + 1
Loop


'Application.ScreenUpdating = True




End Sub

 

[King Bill]

ich glaube ich weiß jetzt wo es hakt. Denn einige Bilder kommen mehrmals in der Liste vor. Und da wird das Problem sein.