ich hätte eine Frage zum Exportieren von Diagrammen als Grafiken.
Thorsten hat weiter unten das von Harald Staff stammende Script zur Erstellung von Grafiken aus Zellbereichen wiedergegeben (s.u.) Bei mir funktioniert das Script - aber nur bis zu einem gewissen Ausschnittsbereich. Zwar erstellt das Script Diagramme in DinA 4 Größe. Diese werden aber nur partiell in die Grafik exportiert, dh ddas Gif File ist nur halb so groß wie die eigentliche grafik, die eportiert werden soll. es scheint, als sollten keine größeren Ausschnitte exportiert werden können. Kann das sein? weiß jemand Abhilfe?
Viele Grüße
Björn
Public Sub GIF_shot()
Dim varReturn As Variant
Dim MyAddress As String
Dim SaveName As Variant
Dim MySuggest As String
Dim Hi As Integer
Dim Wi As Integer
Dim Suffiks As Long
Set Sourcebok = ActiveWorkbook
MySuggest = sShortname(ActiveSheet.Name)
ImageContainer_init
Sourcebok.Activate
MyAddress = SelectArea
If MyAddress <> "A1" Then
SaveName = Application.GetSaveAsFilename( _
InitialFileName:=MySuggest _
& ".gif", fileFilter:="Gif Files (*.gif), *.gif")
Range(MyAddress).Select
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
If SaveName = False Then
GoTo Avbryt
End If
If InStr(SaveName, ".") Then SaveName _
= Left(SaveName, InStr(SaveName, ".") - 1)
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
Hi = Selection.Height + 100 'adjustment for gridlines
Wi = Selection.Width + 2 'adjustment for gridlines
containerbok.Activate
ActiveSheet.ChartObjects(1).Activate
MakeAndSizeChart ih:=Hi, iv:=Wi
ActiveChart.Paste
ActiveChart.Export FileName:=LCase(SaveName) & _
".gif", FilterName:="GIF"
ActiveChart.Pictures(1).Delete
Sourcebok.Activate
End If
Avbryt:
On Error Resume Next
Application.StatusBar = False
containerbok.Saved = True
containerbok.Close
End Sub