Thomas Risi Softwareentwicklung

Chart2Image (2)

Immer wieder Thema in den diversen Foren ... Wie stelle ich ein Diagramm einer Tabelle in einer UserForm dar?

Hier eine API-Lösung, die die Charts zuerst in das Clipboard und dann in eine UserForm lädt.


Quellcode für eine UserForm mit zwei CommandButtons und einem Image-Control ...

Option Explicit Private Declare Function IIDFromString Lib "ole32.dll" ( _ ByVal lpsz As String, _ ByRef lpiid As GUID) As Long Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _ ByRef PicDesc As PICTDESC, _ 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 PICTDESC cbSizeOfStruct As Long picType As Long hgdiObj As Long hPalOrXYExt As Long End Type Private Const S_OK = 0& Private Const PICTYPE_BITMAP = 1& Private Const CF_BITMAP = 2& Private Const IMAGE_BITMAP = 0& Private Const LR_COPYRETURNORG = 4& Private Sub CommandButton1_Click() Call ChartFromClipboard(Tabelle1.ChartObjects(1)) End Sub Private Sub CommandButton2_Click() Call ChartFromClipboard(Tabelle1.ChartObjects(2)) End Sub Public Sub ChartFromClipboard(chrt As Excel.ChartObject) Call EmptyClipboard chrt.Chart.CopyPicture Appearance:=xlScreen, Format:=xlBitmap, Size:=xlScreen Me.Image1.Picture = PictureFromClipboard End Sub Private Function PictureFromClipboard() As IPictureDisp Const IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}" Dim hCopy As Long, hBitmap As Long, hResult As Long Dim hPicture As IPictureDisp Dim tPictDesc As PICTDESC, piid As GUID If IsClipboardFormatAvailable(CF_BITMAP) <> 0 Then If OpenClipboard(Application.hWnd) <> 0 Then hBitmap = GetClipboardData(CF_BITMAP) If hBitmap <> 0 Then hCopy = CopyImage(hBitmap, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) Call CloseClipboard hResult = IIDFromString(StrConv(IPicture, vbUnicode), piid) If hResult = S_OK Then With tPictDesc .cbSizeOfStruct = Len(tPictDesc) .picType = PICTYPE_BITMAP .hgdiObj = hCopy .hPalOrXYExt = 0& End With Call OleCreatePictureIndirect(tPictDesc, piid, 0&, hPicture) Set PictureFromClipboard = hPicture End If End If End If End If End Function

Bewerten Sie bitte dieses Programm.
1 2 3 4 5
Weniger nützlich Sehr nützlich
Bitte teilen Sie uns mit, warum Sie das Programm so bewertet haben. (optional)