Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CheckBox
BildScreenshot zu CheckBox CheckBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

Userform | Herbers Excel-Forum


Betrifft: Userform von: Remo
Geschrieben am: 23.12.2009 10:49:20

Hi Leute
Mit folgendem Programmteil habe ich Bilder ins Exel importiert und positioniert.

Dim p As Picture

Set p = ActiveSheet.Pictures.Insert(Verzeichnis & Bild)
p.Name = "Pic. " & Bild
p.Left = Range("F" & i).Left
p.Top = Range("F" & i).Top + 10


Nun möchte ich in einer Userform ein Bild als Image anzeigen. Dies geht mit folgemdem Code.

Label1.Caption = ActiveSheet.Shapes.Count
Image1.Picture = LoadPicture(Verzeichnis & Bild)


Nun mein Probelm im Userform
Mit ActiveSheet.Shape.Count sehe ich die Anzahl Bilder. Wie kann ich nun eines dieser Bilder im Image1 anzeigen ohne aus dem Verzeichnis zu laden? Ich möchte die Bilder aus dem ActiveSheet verweden.
Besten dank für eure Hilfe
Remo

  

Betrifft: AW: Userform von: Tino
Geschrieben am: 23.12.2009 12:19:49

Hallo,
hier mal ein Beispiel wie es bei mir funktioniert.

https://www.herber.de/bbs/user/66789.xls

Gruß Tino


  

Betrifft: Korrektur, xl Version Darstellung anders von: Tino
Geschrieben am: 23.12.2009 13:22:36

Hallo,
habe es mal unter xl2003 u. 2007 getestet, die Darstellung ist unterschiedlich.

Hier ein neuer Versuch.
https://www.herber.de/bbs/user/66792.xls

Gruß Tino


  

Betrifft: AW: Korrektur, xl Version Darstellung anders von: Luschi
Geschrieben am: 23.12.2009 13:56:31

Hallo Tino,

daß ist ja nun auch von hinten durch die Brust geschossen, mir fällt aber z.Z auch keine bessere Lösung ein. Für alle, die den Vba-Code nicht so richtig verstanden haben:
- Bild aus der Tabelle 'ImageContainer'auf die Festplatte speichern
- dieses gespeicherte Bild in das Formular laden
- gespeichertes Bild wieder von der Festplatte löschen

Gruß von Luschi
aus klein-Paris


  

Betrifft: Code von Nepumuk von: Tino
Geschrieben am: 23.12.2009 14:03:42

Hallo,
es gibt noch einen Code von Nepumuk um Bilder aus der Zwischenablage zu holen,
vielleicht ist dies einfacher. ;-) (für Hintergrundbild UF)

Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
    ByRef PicDesc As PIC_DESC, _
    ByRef RefIID As GUID, _
    ByVal fPictureOwnsHandle As Long, _
    ByRef IPic As IPictureDisp) As Long
Private Declare Function CopyImage Lib "user32.dll" ( _
    ByVal handle As Long, _
    ByVal un1 As Long, _
    ByVal n1 As Long, _
    ByVal n2 As Long, _
    ByVal un2 As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" ( _
    ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32.dll" ( _
    ByVal hWnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" ( _
    ByVal wFormat As Integer) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long

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

Private Type PIC_DESC
    lngSize As Long
    lngType As Long
    lnghPic As Long
    lnghPal As Long
End Type

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

Private Function Paste_Picture() As IPictureDisp
Dim lngReturn As Long, lngCopy As Long, lngPointer As Long
Dim i As Long
    If IsClipboardFormatAvailable(CF_BITMAP) <> 0 Then
        lngReturn = OpenClipboard(FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption))
        If lngReturn > 0 Then
            lngPointer = GetClipboardData(CF_BITMAP)
            lngCopy = CopyImage(lngPointer, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
            Call CloseClipboard
            If lngPointer <> 0 Then Set Paste_Picture = Create_Picture(lngCopy, 0&, CF_BITMAP)
        End If
    End If
    
End Function

Private Function Create_Picture( _
        ByVal lnghPic As Long, _
        ByVal lnghPal As Long, _
        ByVal lngPicType As Long) As IPictureDisp
    
    Dim udtPicInfo As PIC_DESC, udtID_IDispatch As GUID
    Dim objPicture As IPictureDisp
    
    With udtID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    
    With udtPicInfo
        .lngSize = Len(udtPicInfo)
        .lngType = PICTYPE_BITMAP
        .lnghPic = lnghPic
        .lnghPal = lnghPal
    End With
    
    Call OleCreatePictureIndirect(udtPicInfo, udtID_IDispatch, 0&, objPicture)
    
    Set Create_Picture = objPicture
    
End Function

Public Sub Show_Range()
    
    Dim objPicture As IPictureDisp
    
    Call EmptyClipboard

    
    Set objPicture = Paste_Picture
    
    If Not objPicture Is Nothing Then
        UserForm1.Picture = objPicture
    Else
        MsgBox "Error - Range can't show in Userform", vbCritical, "Error"
    End If
    
    UserForm1.Show
    
End Sub
Gruß Tino


  

Betrifft: AW: Korrektur, xl Version Darstellung anders von: Reinhard
Geschrieben am: 23.12.2009 14:10:25

Hallo Tino,

ich habe es mit XL2000 getestet.

Bei deiner ersten Version kommt Fehler 1004 bei

.Chart.Export Filename:=SaveName & ".bmp", FilterName:="bmp"

Nehme ich anstatt bmp gif, so klappt es.

Gruß
Reinhard


  

Betrifft: hatte ich unter xl2003 auch gemerkt,... von: Tino
Geschrieben am: 23.12.2009 14:13:29

Hallo,
daher habe ich es in der zweiten auch geändert.

Gruß Tino


  

Betrifft: hier noch die Version mit dem Code von Nepumuk von: Tino
Geschrieben am: 23.12.2009 14:45:49

Hallo,
getestet unter xl2007 und 2003

https://www.herber.de/bbs/user/66797.xls

Gruß Tino


  

Betrifft: AW: hier noch die Version mit dem Code von Nepumuk von: Remo
Geschrieben am: 24.12.2009 09:11:42

Hallo,
Vielen Dank an alle die mir geholfen haben. Am besten gefällt mir die Version von Nepumuk, wenn ich auch nicht alles verstehe, läuft es dennoch einwandfrei.
Gruss
Remo


  

Betrifft: AW: Userform von: Reinhard
Geschrieben am: 23.12.2009 14:30:15

Hallo Remo,

füge in dem Hilfsblatt die Bildernicht als Grafik ein. Sondern erstelle 50 Images aus dem Steuerelemen "Bild".

Darein lädst du pro Image ein Bild mit

Image1.Picture = LoadPicture("C:\test\kwformel.jpg")
(Der Code muß so im Modul das Hilfsblattes stehen.)

In der Uf dann einfach so:

Private Sub UserForm_Initialize()
UserForm1.Image1.Picture = Tabelle1.Image1.Picture
End Sub

Gruß
Reinhard


Beiträge aus den Excel-Beispielen zum Thema "Userform "