Hallo,
ich suchte seit einiger Zeit ein VBA Skript, dass Skizzen in eine Excel Zelle automatisch einfügt.
Im Internet habe ich ein Skript gefunden, mit dem ich der Meinung war, dies könnte ich einsetzen.
Beschreibung:
Die Skizzen liegen als JPG Dateien unter D:\Daten\Skizzen. Die Skizzen haben eine Höhe von 50 Pixel.
Die Skizzen sind fortlaufend Nummeriert
Das Arbeitsblatt liegt unter D:\Daten\Vorlagen. In der Spalte "A" ab A2 bis A100 werden die fortlaufende Nummer eingetragen.
Dabei sollen automatisch die Skizzen in der Spalte "C" ab C2 bis C100 eingefügt werden.
Bei löschen der fortlaufenden Nummer ( Z.B. A5 ) in der Spalte "A" soll auch die dementsprechende Skizze gelöscht werden.
folgender gefundene VBA Code.
Option Explicit
Sub Skizze einfügen()
Dim strPfad As String, lngWiederholungen As Long
Dim picBild As Picture
On Error Resume Next
strPfad = "D:\Daten\Skizzen\"
For lngWiederholungen = 1 To Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
ActiveSheet.Shapes(Cells(lngWiederholungen, 1)).Delete
On Error GoTo 0
Set picBild = ActiveSheet.Pictures.Insert(strPfad & Cells(lngWiederholungen, 1) & ".jpg")
With picBild
.Name = Cells(lngWiederholungen, 1)
.Top = Cells(lngWiederholungen, 3).Top
.Left = Cells(lngWiederholungen, 3).Left
.Height = 50
End With
Next lngWiederholungen
Set picBild = Nothing
End Sub
Die Fehlermeldung heißt:
Laufzeitfehler 1004. Die Insert-Eigenschaft des Pictures-Objektes kann nicht zugeordnet werden.
Ich verwende Excel 2007
Da ich kein VBA - Kenner bin, stelle ich hier die Frage: Wer kann mir bei dieser gestellten Frage helfen?
Gruß Max
Office - Word, Excel und Co. 9.753 Themen, 41.598 Beiträge
Hallo Max,
. Skizzen in eine Excel Zelle automatisch einfügt.
bei dir soll wohl alles automatisch erfolgen?
Da wird dir nichts anderes übrig bleiben, als einen VB-Kurs zu machen...
Bei mir kopiere ich Skizzen/Bilder einfach in die markierte Zelle ein.
Frohe Weihnachten und Grüsse
hac004
Hallo hac004,
Deinen Vorschlag einen VB Kurs zumachen habe ich schon Anfang November in die Tat umgesetzt und habe mich bei der VHS angemeldet. Leider beginnt dieser Kurs voraussichtlich erst März 2011, genaues Datum liegt noch nicht fest. Schade.
Ich wünsche Dir auch Frohe Weihnachten.
Gruß Max
Servus,
leider sind meine VBA Kenntnisse hierzu nicht ausreichend - als Überbrückung für die Wartezeit empfehle ich dir aber das m.M.n. sehr gute Skript der Fern-Uni Hagen zum Thema "VBA - Programmierung mit Excel" (125 Seiten): ftp://ftp.fernuni-hagen.de/pub/pdf/urz-broschueren/broschueren/b0129911.pdf
BG,
Bergi2002
Hallo Bergi2002,
Besten Dank für diesen Tip. Ich habe dieses Skript sofort heruntergeladen und werde mich an den Versuch VBA Programierung versuchen.
Jedoch ist es schade, dass mir keiner weiterhelfen kann.
Auch Dir wünsche ich Frahe Weihnachten.
Gruß Max
Hallo,
Nachdem ich von Bergi2002 den Tip bekommen habe, als Überbrückung für die Wartezeit,
das Skript der Fern-Uni Hagen zum Thema "VBA - Programmierung mit Excel zu bearbeiten, habe ich mich gleich ans Werk gemacht und den ersten Gehversuch gestartet.
Ich habe 2 Test Dateien angelegt. Die Skizzen liegen als JPG Dateien unter J:\Prospekt_Bilder. Die Bilder sind fortlaufend Nummeriert. (6 stellig Zahl)
Das Arbeitsblatt liegt unter J:\Prospekt. In der Tabelle1 Spalte A ab A2 bis A....? sind die fortlaufende Nummer eingetragen.
Die Bilder werden in der Spalte B ab B2 bis B....? per Button eingefügt. Dies funktioniert auch sehr Gut.
Bei nochmaligen Klick auf den Button werden die Bilder allerdings nochmals eingefügt, was nicht sein soll.
Kann mir diesbezüglich jemand ein Tip geben wie ich dies in meinem Code einfügen kann ?
Sub BilderEinfügen()
Dim pfad, lastrow, i, Dateiname
pfad = "J:\Prospekt_Bilder\"
lastrow = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
If Range("A" & i) "" Then
Dateiname = Dir(pfad & Range("A" & i) & "*")
If Dateiname "" Then
Set pic = ActiveSheet.Pictures.Insert(pfad & Dateiname)
pic.Name = Range("B" & i).Address
pic.Top = Range("B" & i).Top
pic.Left = Range("B" & i).Left
pic.ShapeRange.LockAspectRatio = msoFalse
pic.Width = Range("B1").Width
pic.Height = Range(Range("A" & i), Range("A" & i).Offset(, 1)).Height
Else
Range("B" & i) = "Bild nicht gefunden"
End If
End If
Next