Thema Datum  Von Nutzer Rating
Antwort
26.08.2020 11:13:11 Michael S
NotSolved
26.08.2020 12:43:22 Gast14354
***
NotSolved
Rot Fotos in Tabelle einbetten / in UserForm anzeigen?
26.08.2020 13:14:05 volti
*****
Solved

Ansicht des Beitrags:
Von:
volti
Datum:
26.08.2020 13:14:05
Views:
462
Rating: Antwort:
 Nein
Thema:
Fotos in Tabelle einbetten / in UserForm anzeigen?

Hallo Michael,

eine Beispieldatei wäre hier angebracht.

Denn um ein Bild aus einem Tabellenbereich in einer Userform anzeigen zu lassen, bedarf es einigen Aufwands mittels API-Functions, mal abgesehen von Deinen anderen Wünschen.

Nachfolgend ein Weg, um über die Zeilennummer das dort hinterlegte Bild in einer Userform anzeigen zu lassen. Du kannst Dir dieses bzgl. der Tabellenblätter und Userformname und Imagename leicht anpassen. Beachte, dass ich hier nur API-Befehle für VBA7 (also keine älteren 32-Bit-Officeversionen) eingefügt habe. Falls Du ein älteres Excel hast, kann ich dir gerne die passenden dazubasteln.

Schau mal, ob Du damit schon weiterkommst:

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 SetClipboardData Lib "user32" (ByVal wFormat As Long, _
        ByVal hMem As LongPtr) As LongPtr
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 Declare PtrSafe Function RegisterClipboardFormat Lib "user32" _
        Alias "RegisterClipboardFormatA" (ByVal lpString As String) 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_ByPosition(iZeile As Long)
'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")
   For Each oShape In .Shapes
     If oShape.TopLeftCell.Address = .Cells(iZeile, "A").Address 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_ByPosition 5
 UserForm1.Show
End Sub

viele Grüße

Karl-Heinz


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
26.08.2020 11:13:11 Michael S
NotSolved
26.08.2020 12:43:22 Gast14354
***
NotSolved
Rot Fotos in Tabelle einbetten / in UserForm anzeigen?
26.08.2020 13:14:05 volti
*****
Solved