Thema: Userform | Herbers Excel-Forum

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

Hallo,
hier mal ein Beispiel wie es bei mir funktioniert.
https://www.herber.de/bbs/user/66789.xls
Gruß Tino

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

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

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

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

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

Hallo,
getestet unter xl2007 und 2003
https://www.herber.de/bbs/user/66797.xls
Gruß Tino

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

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