Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Userform

Userform
Remo
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

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Korrektur, xl Version Darstellung anders
23.12.2009 13:22:36
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
AW: Korrektur, xl Version Darstellung anders
23.12.2009 13:56:31
Luschi
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
Anzeige
Code von Nepumuk
23.12.2009 14:03:42
Nepumuk
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
Anzeige
AW: Korrektur, xl Version Darstellung anders
23.12.2009 14:10:25
Reinhard
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
hatte ich unter xl2003 auch gemerkt,...
23.12.2009 14:13:29
Tino
Hallo,
daher habe ich es in der zweiten auch geändert.
Gruß Tino
AW: hier noch die Version mit dem Code von Nepumuk
24.12.2009 09:11:42
Nepumuk
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
Anzeige
AW: Userform
23.12.2009 14:30:15
Reinhard
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

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige