speicher mit folgendem Code eine Grafik aus einer Tabelle.
Mein Problem: der Auschnitt des Bildes ist links ond oben etwas größer als die Grafik. Dadurch entsteht ein weißer Rand den ich nicht brauche.
Kann mir jemand sagen wie ich den Code ändern muß damit dieser Rand weg ist? (Durch die Width- und Heighteinstellungen konnte ich wenigstens den unteren und rechten Rand beseitigen)
Vielen im Voraus für die Hilfe
Gruß
Felix
Dim container As Chart
Dim containerbok As Workbook
Dim AK As String
Private Sub ImageContainer_init()
Workbooks.Add (1)
ActiveSheet.Name = "GIFcontainer"
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="GIFcontainer"
Set containerbok = ActiveWorkbook
Set container = ActiveChart
End Sub
Sub MakeAndSizeChart(ih As Integer, iv As Integer)
Dim Höhe As Single
Dim Breite As Single
AK = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
Höhe = ih / ActiveChart.ChartArea.Height
ActiveSheet.Shapes(AK).ScaleHeight Höhe, msoFalse, msoScaleFromTopLeft
Breite = iv / ActiveChart.ChartArea.Width
ActiveSheet.Shapes(AK).ScaleWidth Breite, msoFalse, msoScaleFromTopLeft
End Sub
Public Sub GIF_Snapshot()
Dim varReturn As Variant
Dim MySuggest As String
Dim Hi As Integer
Dim Wi As Integer
Dim Suffiks As Long
Dim BildName As String
BildName = "Krankenhaus1"
ImageContainer_init
ThisWorkbook.Activate
ActiveSheet.Shapes("AK_1").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Hi = Selection.Height + 2 'adjustment for gridlines
Wi = Selection.Width + 3 'adjustment for gridlines
containerbok.Activate
ActiveSheet.ChartObjects(1).Activate
MakeAndSizeChart ih:=Hi, iv:=Wi
ActiveChart.Paste
ActiveChart.Export Filename:=LCase(BildName) & ".gif", FilterName:="GIF"
ActiveChart.Pictures(1).Delete
On Error Resume Next
Application.StatusBar = False
containerbok.Saved = True
containerbok.Close
End Sub