VBA Bild aus variablem Verzeichnis einfügen

[ChristianH.]

Hallo Zusammen,

ich hab ein kleines oder doch eher großes Problem mit dem Einfügen eines Bildes in einen Zellbereich.
Aktuell wird mir bei meinem Code der Explorer geöffnet und anhand einer Nummer (z.B.:170400-1)
der entsprechende Pfad ermittelt. Danach kann die Datei (.jpg) ausgewählt werden und auf öffnen
gedrückt werden. Aktuell hab ich momentan nur eine MsgBox die mir dann angezeigt wird. Da ich
leider nicht ganz verstehe wie ich hier sage, dass das Bild eingefügt werden soll.

Wäre echt froh wenn mir hier jemand beantworten könnt, wie ich den Code erweitere für das Einfügen
des Bildes und zur Bestimmung in welchen Zellbereich dieser eingefügt werden soll.

Code:

Private Sub CommandButton2_Click()
'Bild einfügen
ActiveSheet.Unprotect Password:=""

With Application.FileDialog(1)
     .InitialFileName = "V:\" & Left(Range("m10").Value, 2) & "0000\" _
     & Left(Range("m10").Value, 4) & "00\" _
     & Left(Range("m10").Value, 6) & "\" _
     & Range("m10").Value _
     & "\_fertigung\RT_MB\"
     
If .Show Then MsgBox ("Hier sollte das Bild eingefügt werden")
End With

ActiveSheet.Protect Password:=""
End Sub

[Kuwer]

Hallo Christian,

z.B. so:

Private Sub CommandButton2_Click()

 'Bild einfügen

 ActiveSheet.Unprotect Password:=""

 

 With Application.FileDialog(1)

     .AllowMultiSelect = False

     .InitialFileName = "C:\" & Left(Range("m10").Value, 2) & "0000\" _

     & Left(Range("m10").Value, 4) & "00\" _

     & Left(Range("m10").Value, 6) & "\" _

     & Range("m10").Value _

     & "\_fertigung\RT_MB\"

     

     If .Show Then ActiveSheet.Pictures.Insert .SelectedItems(1)

 End With

 

 ActiveSheet.Protect Password:=""

End Sub

Code eingefügt mit: Excel Code Jeanie


Gruß Uwe

[ChristianH.]

Morgen Uwe,

danke für deine Antwort aber leider kommt hier ein Laufzeitfehler 449 ( Argument ist nicht optional).

Eine Idee an was das liegt?

[Kuwer]

Hallo Christian,

... leider kommt hier ein Laufzeitfehler 449 ( Argument ist nicht optional).
Eine Idee an was das liegt?

da habe ich keine Idee. Bei mir läuft das problemlos.

Gruß Uwe

[ChristianH.]

Hallo Uwe,

hab es jetzt etwas anders gelöst und Danke für deinen Tipp. Hat mir wirklich geholfen, ab und zu bekommt man die leichtesten Sachen
nicht mehr her. Bei meinem neuen Code können bis zu vier Bilder ausgewählt und eingefügt werden.

Code:

  Dim bytBild As Byte
Dim arrBereiche()
  arrBereiche = Array("C111:L122", "M111:V122", "C123:L134", "M123:V134")
  Application.ScreenUpdating = False
  With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     .InitialFileName = "V:\" & Left(Range("m10").Value, 2) & "0000\" _
     & Left(Range("m10").Value, 4) & "00\" _
     & Left(Range("m10").Value, 6) & "\" _
     & Range("m10").Value _
     & "\_fertigung\RT_MB\"
     .ButtonName = "OK"
     .Title = "Bilderauswahl"
     .Show
     If .SelectedItems.Count < 5 Then
        For bytBild = 1 To .SelectedItems.Count
           strBild = .SelectedItems(bytBild)
          With ActiveSheet.Shapes.AddPicture(strBild, msoFalse, _
               msoTrue, 0, 0, -1, -1)
              .Top = Range(arrBereiche(bytBild - 1)).Top
              .Left = Range(arrBereiche(bytBild - 1)).Left
              .Height = Range(arrBereiche(bytBild - 1)).Height
           End With
        Next bytBild
       Else
        MsgBox "Maximal 4 Bilder auswählbar"
     End If
  End With
  Application.ScreenUpdating = True