Re: Pictures aus Tabelle in Userform anzeigen
28.02.2003 14:01:56
Karl Limburger
HalloDanke Danke Nepumuk
ich habe es getestet, für sehr gut befunden und etwas umgebastelt.
Geht etwas schneller.
Public Sub Bildspeichern()
Dim varReturn As Variant, MyAddress As String, SaveName As Variant, MySuggest As String
Dim Hi As Integer, Wi As Integer, Suffiks As Long
Dim Internrange As Range
Dim Hincrease As Single, Vincrease As Single
Set Internrange = Range("A1")
Worksheets.Add
ActiveSheet.Name = "GIFcontainer"
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.Location Where:=xlLocationAsObject, Name:="GIFcontainer"
ActiveChart.ChartArea.ClearContents
MyAddress = Internrange.Address
SaveName = "C:\test\Testbild1.jpg"
Worksheets("Daten").Select
Range(MyAddress).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Hi = Selection.Height + 4
Wi = Selection.Width + 6
Worksheets("GIFContainer").Select
ActiveSheet.ChartObjects(1).Activate
Obnavn = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
Hincrease = Hi / ActiveChart.ChartArea.Height
ActiveSheet.Shapes(Obnavn).ScaleHeight Hincrease, msoFalse, msoScaleFromTopLeft
Vincrease = Wi / ActiveChart.ChartArea.Width
ActiveSheet.Shapes(Obnavn).ScaleWidth Vincrease, msoFalse, msoScaleFromTopLeft
ActiveChart.Paste
ActiveChart.Export Filename:=LCase(SaveName) & ".gif", FilterName:="GIF"
ActiveChart.Pictures(1).Delete
Application.DisplayAlerts = False
Worksheets("GIFContainer").Delete
End Sub
Gruss Karl