Diagramm in Userform übertragen

03.02.2025 12:32:13

Anfängervba

Hallo zusammen,

Ich habe hier öfters nach Lösungen gesucht und gefunden. Ich komme bei einem Punkt überhaupt nicht weiter.

Ich möchte Diagramme von Excel in die Userform einfügen und verwende den folgenden Code:

Private Sub Initialize()

Dim Pivt As PivotTable
Dim Slicer As SlicerCache
'Refresh Pivot Table
For Each Pivt In Tabelle2.PivotTables
Pivt.PivotCache.Refresh
Next
'Reset Slicer
For Each Slicer In ActiveWorkbook.SlicerCaches
Slicer.ClearManualFilter
Next
For ChNo = 1 To 3
FilePath = Environ$("Temp") & "\Chart" & ChNo & ".jpg"
Tabelle2.Activate
Tabelle2.Shapes("Chart" & ChNo).Select
ActiveChart.Export FilePath
Me("Img" & ChNo).Picture = LoadPicture(FilePath)
Kill FilePath
Next ChNo

End Sub

Es kommt Laufzeitfehler-214702…
Das Element mit dem angegeben Namen wurde nicht gefunden.

Die excel hat Pivot-Tabellen, wo ich Datenschnitte gesetzt habe und die 3 Diagramme die Namen Chart1,2 und 3 gegeben habe.

In der Userform habe ich alles weggemacht da ist jetzt nur noch die Image blöcke -> Img1,2 und 3 für die Diagramme.

Ich hoffe ihr könnt mir helfen, weiß echt nicht weiter wie ich das hinbekomme. Auch bei debuggen und direktenbereich komme ich da nicht auf das Ergebnis das die Diagramme übertragen werden besser gesagt in der Userform erscheinen.

Ich danke euch

Beste Grüße

Max

AW: Diagramm in Userform übertragen

03.02.2025 13:59:43

volti

Hallo Max,

ohne Datei kann ich das nicht nachvollziehen bzw. testen. Du gibst ja auch nicht die Stelle des Fehlers an.

Ich denke, es könnte daran liegen, dass hier ein Leerzeichen nach Chart fehlt.
Tabelle2.Shapes("Chart " & ChNo).Select

Hier noch ein Alternativvorschlag ohne den Umweg über die Datei. (teilgetestet)

Code:


Option Explicit
' Diagramm in Userform einbinden

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 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 Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Type PIC_DESC
   lSize As Long
   lType As Long
   hPic  As LongPtr
   hPal  As LongPtr
End Type

Private Const PICTYPE_BITMAP   As Long = 1
Private Const CF_BITMAP        As Long = 2
Private Const IMAGE_BITMAP     As Long = 0
Private Const LR_COPYRETURNORG As Long = &H4

Sub Paste_Picture_In_UF(UF As Object)
' Fügt ein Bild aus der Zwischenablage in ein Userform-Control ein
  Dim oPict As IPictureDisp
  Dim tPicInfo As PIC_DESC, tID_IDispatch As GUID

  If IsClipboardFormatAvailable(CF_BITMAP) <> 0 Then
     If OpenClipboard(0&) <> 0 Then
        
        With tID_IDispatch
             .Data1 = &H20400
             .Data4(0) = &HC0
             .Data4(7) = &H46
        End With
        
        With tPicInfo
             .lSize = LenB(tPicInfo)
             .lType = PICTYPE_BITMAP
             .hPic = CopyImage(GetClipboardData(CF_BITMAP), _
                     IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
             CloseClipboard

             If .hPic <> 0 Then _
                OleCreatePictureIndirect tPicInfo, tID_IDispatch, 0&, oPict

        End With
        
        If Not oPict Is Nothing Then
' ######### Hier die Userform und Image-Angaben anpassen ########
           UF.Picture = oPict
        Else
           MsgBox "Das Bild kann nicht angezeigt werden", vbCritical, "Bild einfügen"
        End If

     End If
  End If

End Sub

Sub CommandButton1_Click()
  Dim ChNo As Long
  
  For ChNo = 1 To 1
      Tabelle2.Shapes("Chart " & ChNo).Copy
      DoEvents                              ' Achtung, wichtig
      Paste_Picture_In_UF Me("Img" & ChNo)  ' Hier das Ziel angeben
  Next ChNo
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

AW: Diagramm in Userform übertragen

03.02.2025 15:19:20

Anfängervba

Ich danke dir für deine Antwort und den Code. Anbei habe ich dir die Datei angehangen :) Ich probiere solange dein Code aus :) Ich würde mich über deine Antwort/ Empfehlung über mein Code freuen.
https://www.herber.de/bbs/user/175452.xlsm

AW: Diagramm in Userform übertragen

03.02.2025 15:59:11

volti

Hallo,

so sollte es funktionieren.....

Code:


Private Sub Userform_Initialize()
  Dim Rng    As Range
  Dim Pivt   As PivotTable
  Dim Slicer As SlicerCache
' Refresh Pivot Table
  For Each Pivt In Tabelle2.PivotTables
      Pivt.PivotCache.Refresh
  Next
' Reset Slicer
  For Each Slicer In ActiveWorkbook.SlicerCaches
      Slicer.ClearManualFilter
  Next

  Tabelle1.Select
  Set Rng = ActiveCell
  For ChNo = 1 To 3
      FilePath = Environ$("Temp") & "\Chart" & ChNo & ".jpg"
      ActiveSheet.ChartObjects("Chart" & ChNo).Activate
      ActiveChart.PlotArea.Select
      ActiveChart.Export FilePath
      Me("Img" & ChNo).Picture = LoadPicture(FilePath)
      Kill FilePath
  Next ChNo
  Rng.Select
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Diagramm in Userform übertragen

Forumthread: Diagramm in Userform übertragen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Diagramm in Userform übertragen

Forumthread: Diagramm in Userform übertragen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread