Einfügen von Bilder via VBA aus eine Ordner auf dem PC

[Primo Centurio]

Das Wäre der Code:

Code:

Private Sub CommandButton1_Click()
 
' Eintrag in Tabelle Badge Daten

Dim intErsteLeereZeile As Long

   
     intErsteLeereZeile = Worksheets("BadgeDaten").Cells(Rows.Count, 1).End(xlUp).Row + 1
     Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 1).Value = Me.Label9
   
   Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 2).Value = Me.txtNachname.Text
    ' Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 2).Value = Me.ComboNachname.Text -- falsche deklaration
     Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 3).Value = Me.txtVorname.Text
    Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 4).Value = Me.ComboAusweis.Text
     Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 5).Value = Me.ComboFirma.Text
    Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 6).Value = Me.ComboGrund.Text
     Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 7).Value = Me.txtAutoNr.Text
     Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 8).Value = Me.ComboVerantwortlich.Text
     Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 9).Value = Me.txtGültigBis.Text
     Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 10).Value = Me.txtBadgeNr.Text
   Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 11).Value = Me.ComboAusstellort.Text
    ' Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 11).Value = Me.txtBadgeNr.Text
     Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 15).Value = Me.ComboLogenMA.Text
      Worksheets("BadgeDaten").Cells(intErsteLeereZeile, 18).Value = Me.ComboBadgeArt
 
 
   Dim strFahne As String
   Application.ScreenUpdating = False
   If Target = Worksheets("BadgeDaten").Range("C3") Then
       strFahne = Target
       Worksheets("HWBadgeLam").Range("A6").Select
       ActiveSheet.Pictures.Delete
       ActiveSheet.Pictures.Insert ("C\\ifc1.ifr.intra2.admin.ch\Userhomes\UE1211589\Desktop\Diverses\Fahnen" & strFahne & ".png")
       Worksheets("HWBadgeLam").Range("K38").Select
   End If
   Application.ScreenUpdating = True
 

 ' öffnet Tabellenblatt HWBadgeLam und druckt
Worksheets("HWBadgeLam").Visible = True
Worksheets("HWBadgeLam").Activate

ActiveWindow.SmallScroll Down:=-36
   Range("A1:m57").Select
  Range("A50").Activate
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
       IgnorePrintAreas:=False
   ActiveWindow.SmallScroll Down:=-15
   
Worksheets("HWBadgeLam").Visible = False

Unload UserForm10
UserForm10.Show

End Sub

[Helvetier]

Hallo Matteo
Zu meiner Schande muss ich gestehen, dass ich nicht verstehe, was dieser Code soll. In jedem Falle funktioniert er so nie und nimmer. Guter Rat ist "teuer":
Es finden irgendwelche Aktionen im sheet "Badgedaten". Beteiligt ist ein Label9.
Dann gibt es Aktionen in einem sheet "HWBadgeLam". Target kann natürlich keinen Inhalt haben, wenn das Makro mit einem Commandbutton gestartet wird.
Ich hoffe, dass ein anderer Forumsteilnehmer, dessen hellseherischen Fähigkeiten weiterentwickelt sind, Dir helfen kann ....oder es sei denn, dass Du weitere Infos liefern kannst.
Gruss

[Primo Centurio]

Ja das kann ich mir vorstellen, ist auch schwer zu verstehen wenn man nicht weiss wofür es gebraucht wird was der Code durchführt ist mir bekannt ;) . Ich habe jedoch noch eine andere Idee, welche ich probieren werde. Danke dir tausendmal für deine Hilfe  :19:

[Primo Centurio]

Leider habe ich es nicht geschafft. Danke euch allen trotzdem für die Hilfe :D

[Primo Centurio]

Hallo miteinander

nach langem experimentieren habe ich eine ander möglichkeit gefunden und zwar mit folgendem Code.

Code:

Private Sub CommandButton2_Click()
Dim strPfad As String
Dim strDatei As String
Dim lngZeile As Long
Dim lngSpalte As Long
Dim wksTabelle As Worksheet
Dim shpNeu As Object
lngSpalte = 5 ' =C
Set wksTabelle = ActiveWorkbook.Worksheets("Daten")
For lngZeile = 3 To 7
  strPfad = wksTabelle.Cells(lngZeile, 3).Text
  strDatei = wksTabelle.Cells(lngZeile, 2).Text
  If Right(strPfad, 3) <> "\" Then strPfad = strPfad & "\"
  If UCase(Dir(strPfad & strDatei, vbNormal)) <> UCase(strDatei) Then
   MsgBox strPfad & strDatei, , "Diese gibts nicht:"
  Else
   Set shpNeu = wksTabelle.Pictures.Insert(strPfad & strDatei)
   shpNeu.Top = wksTabelle.Rows(lngZeile).Top
   shpNeu.Height = wksTabelle.Rows(lngZeile).Height
   shpNeu.Left = wksTabelle.Columns(lngSpalte).Left
   shpNeu.Width = wksTabelle.Columns(lngSpalte).Width
  End If
Next
End Sub

Jetzt möchte ich aber, dass das Bild fix einer Zelle zugeordent ist, damit ich bei zum Beispiel Tabelle2 mit der Formel =Tabelle1!F3 das bild nochmals anzeigen kann. Wie bring ich das hin?

Gruss Matteo

[Helvetier]

Hallo Mateo
Ich habe Dir einen getesteten Code geliefert, der nach Deiner Aufgabenstellung eine png - Datei in ein Excelsheet einfügt. Du hast es nicht zum Laufen gebracht. Nun präsentierst Du einen Code, in dem von einer png-Datei keine Rede ist. Du änderst ganz einfach die Aufgabenstellung, die ich nun nicht verstehe. Ich habe Null Bock mich mit Deiner Arbeitsweise zu befassen.
Gruss

[schauan]

Hallo Matteo,

für die Zeile und Spalte verwendest Du Variablen. Nimm dort die festen Werte für F3.
Hast Du denn mit einer Formel schon mal ein Bild erneut zur Anzeige gebracht?