Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Einen Tabellenblattbereich als Graf in UserForm einbinden

Gruppe

UserForm

Problem

Der Tabellenblattbereich C6:D8 soll in einer UserForm als ScreenShot dargestellt werden.

Lösung
Geben Sie den Ereigniscode in die nachfolgend genannten Module ein.

StandardModule: Modul1

Dim container As Chart
Dim ContainerBook As Workbook
Dim Obnavn As String
Dim SourceBook As Workbook

Public Sub DialogAufruf()
   Call GIF_Snapshot
   Application.ScreenUpdating = False
   frmSnapShot.Image1.Picture = LoadPicture( _
      Application.DefaultFilePath & "\img.gif")
   frmSnapShot.Show
   Application.ScreenUpdating = False
End Sub

Private Sub ImageContainer_init()
   Workbooks.Add 1
   ActiveSheet.Name = "GIFcontainer"
   Charts.Add
   ActiveChart.ChartType = xlColumnClustered
   ActiveChart.SetSourceData Source:=Worksheets(1).Range("A1")
   ActiveChart.Location Where:=xlLocationAsObject, _
      Name:="GIFcontainer"
   ActiveChart.ChartArea.ClearContents
   Set ContainerBook = ActiveWorkbook
   Set container = ActiveChart
End Sub

Private Sub MakeAndSizeChart(ih As Integer, iv As Integer)
   Dim Hincrease As Single
   Dim Vincrease As Single
   Obnavn = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
   Hincrease = ih / ActiveChart.ChartArea.Height
   ActiveSheet.Shapes(Obnavn).ScaleHeight Hincrease, _
      msoFalse, msoScaleFromTopLeft
   Vincrease = iv / ActiveChart.ChartArea.Width
   ActiveSheet.Shapes(Obnavn).ScaleWidth Vincrease, _
      msoFalse, msoScaleFromTopLeft
End Sub

Private Sub GIF_Snapshot()
   Dim SaveName As Variant
   Dim Hi As Integer
   Dim Wi As Integer
   Set SourceBook = ActiveWorkbook
   Call ImageContainer_init
   SourceBook.Activate
   SaveName = Application.DefaultFilePath & "\img.gif"
   If Dir(SaveName) <> "" Then
      Kill SaveName
   End If
   Range("C6:D8").Select
   Selection.CopyPicture Appearance:=xlScreen, _
      Format:=xlBitmap
   Hi = Selection.Height + 4
   Wi = Selection.Width + 6
   ContainerBook.Activate
   ActiveSheet.ChartObjects(1).Activate
   Call MakeAndSizeChart(ih:=Hi, iv:=Wi)
   ActiveChart.Paste
   ActiveChart.Export Filename:=LCase(SaveName), _
      FilterName:="GIF"
   ActiveChart.Pictures(1).Delete
   SourceBook.Activate
   On Error Resume Next
   Application.StatusBar = False
   ContainerBook.Saved = True
   ContainerBook.Close
End Sub

ClassModule: frmSnapShot

Private Sub cmdCancel_Click()
   Unload Me
End Sub

    

Beiträge aus dem Excel-Forum zu den Themen Grafik und UserForm