UserForm Bild einfügen

Guten Morgen liebes Excel-Forum,
ich hänge wieder mal bei einem Problem, was ich trotz Internetsuche nicht gelöst bekomme. Ich habe eine UserFrom-Multiseiten erstellt. Bei klicken auf Weiter soll die nächste Seite geladen werden und verschiedne Sachen ausgegeben werden. Das funktioniert soweit sehr gut. Jetzt möchte ich aber auf der nächsten Seite auch ein Bild einfügen. Das funktioniert nicht, trotz der Hinweise aus mehreren Foren, bekomme ich es nicht gelöst. Fehler sind entsprechend hinter den den zwei versuchten Möglichkeiten zu sehen.
Ein kurzer Code-Ausschnitt:
Dim Com1 As String
Dim x1 As String
If MultiPage1.Value < (MultiPage1.Pages.Count + 1) Then
MultiPage1.Value = MultiPage1.Value + 1
Com1 = ComboBox1.Value
Label1.Caption = "Ergebnis von " & Com1
x1 = ActiveWorkbook.Worksheets(Com1).Shapes(1).Name 'Shape wird gefunden und x1 enthält den korrekten Namen des Bildes
'der Name meines Images ist Gefüge (selber entsprechend umbenannt, funktionier bei Labels entsprechend gut)
'Beide Codes aus dem Internet gefunden, funktionieren bei meiner Anwendung aber nicht und ich weiß nicht warum? -> Fehlermeldung
Gefüge.Picture = ActiveWorkbook.Worksheets(Com1).OLEObjects(x1).Object.Picture -> Die OLEObjects-Eigenschaft des Worksheet-Objektes kann nicht zugeordnet werden
'Gefüge.Picture = CallByName(ActiveWorkbook.Worksheets(Com1),x1, VbGet).Picture -> Objekt unterstütz diese Eigenschaft oder Methode nicht
End If
Ich vermute, dass es über nochmals abspeichern und LoadPicture funktionieren könnte, das möchte ich aber vermeiden.
Noch zur Info, die Bilder sind alle mit dem Workbook abgespeichert und keine Verknüpfung.
Mit dem Thema noch verunden, gleich noch eine Frage, und zwar möchte ich auch ein Diagramm einfügen, da habe ich bisher nur gefunden, dass es über Speichern als Bild und LoadPicture geht, das habe ich auch hinbekommen; finde das aber sehr umständlich und wollte nochmal erfragen, ob es da nicht eine elegantere Lösung gibt (ähnlich zu den oberen zwei Codes)?
Schon mal vielen Dank für jede Hilfe.
Viele Grüße Darius

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Darius,
mit folgendem Code kannst Du ein in einer Tabelle vorhandenes Bild anhand seines Namens in eine Userform einbetten.
Diagramme ggf. vorher in ein Bild umwandeln.
Achtung: Die angegebenen Parameter noch anpassen....

Code:


[Cc][+][-]

Option Explicit

Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
        ByRef PicDesc As PIC_DESC, ByRef RefIID As GUID, _
        ByVal fPictureOwnsHandle As LongPtr, ByRef IPic As IPictureDisp) As Long
Private Declare PtrSafe Function CopyImage Lib "user32" ( _
        ByVal handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, _
        ByVal n2 As Long, ByVal un2 As Long) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" ( _
        ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" ( _
        ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function OpenClipboard Lib "user32" ( _
        ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
  
Private Type PIC_DESC
       lSize As Long
       lType As Long
       hPic  As LongPtr
       hPal  As LongPtr
End Type
Dim hPic  As LongPtr
  


Private Type GUID
     Data1 As Long
     Data2 As Integer
     Data3 As Integer
     Data4(0 To 7) As Byte
End Type

Private Const PICTYPE_BITMAP = 1
Private Const CF_BITMAP = 2
Private Const IMAGE_BITMAP = 0
Private Const LR_COPYRETURNORG = &H4


Sub Paste_Picture_ByName(sSuch As String)
' Fügt ein Bild aus einer Pic-Sammlung über die Zwischenablage in ein Userform-Control ein
  Dim oPict As IPictureDisp, oShape As Shape
  Dim tPicInfo As PIC_DESC, tID_IDispatch As GUID

' Bild suchen und in die Zwischenablage kopieren
  With ThisWorkbook.Sheets("Tabelle2")              ' Blatt ggf. <<<anpassen>>>
      For Each oShape In .Shapes
          If oShape.Name Like sSuch & "*" Then
             oShape.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
             DoEvents: Exit For
          End If
      Next oShape
  End With

' Bild aus Zwischenablage in das Image einfügen
  If IsClipboardFormatAvailable(CF_BITMAP) <> 0 Then
     If OpenClipboard(0&) <> 0 Then
        hPic = CopyImage(GetClipboardData(CF_BITMAP), _
        IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
        CloseClipboard
        If hPic <> 0 Then
           With tID_IDispatch
               .Data1 = &H20400
               .Data4(0) = &HC0
               .Data4(7) = &H46
           End With

           With tPicInfo
               .lSize = Len(tPicInfo)
               .lType = PICTYPE_BITMAP
               .hPic = hPic
               .hPal = 0
           End With

           OleCreatePictureIndirect tPicInfo, tID_IDispatch, 0&, oPict

           If Not oPict Is Nothing Then
' ######### Hier die Userform und Image-Angaben anpassen ########
              UserForm1.Image3.Picture = oPict
           Else
              MsgBox "Das Bild kann nicht angezeigt werden", vbCritical, "Bild einfügen"
           End If

        End If
     End If
  End If
End Sub

Sub Test()
  Paste_Picture_ByName "Loewe"
  UserForm1.Show
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

UserForm Bild einfügen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread