title image


Smiley Re: Grafiken aus Excel 97 exportieren??? Help!
Mit einem kleinem Trick kann man auch dieses tun.Naemlich den Zellbereich in ein leeres Diagramm kopieren und dann dieses Diagramm als GIF speichern.Ich habe mir dafuer folgendes Makro geschrieben:Sub SaveRangeAsGIF()' Macro to save a range as a gif-file' using the capability of Excel to do so for charts.' Norbert Koehler 1999-08-26 Dim objCurrentShape As Object Dim strCurrentSheet As String Dim strGIFname As String Dim strTempShape As String Dim intExistingCharts As Integer Dim intI As Integer Dim intShapeHeight As Integer Dim intShapeWidth As Integer Range("A1").Select strCurrentSheet = ActiveSheet.Name Selection.CurrentRegion.Select Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture Selection.SpecialCells(xlCellTypeLastCell).Select Selection.Offset(1, 1).Select ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False strTempShape = Selection.Name intExistingCharts = ActiveSheet.ChartObjects.Count 'MsgBox "Nos of existing Charts " & intExistingCharts For intI = 1 To ActiveSheet.Shapes.Count Step 1 'MsgBox ActiveSheet.Shapes.Count & " shape(s) " & ActiveSheet.Shapes(intI).Type ActiveSheet.Shapes(intI).Select If ActiveSheet.Shapes(intI).Type = msoPicture Then intShapeHeight = ActiveSheet.Shapes(intI).Height intShapeWidth = ActiveSheet.Shapes(intI).Width 'MsgBox "Height " & intShapeHeight & " Width " & intShapeWidth strGIFname = ThisWorkbook.Path & "\" & ThisWorkbook.Name & Selection.Name & ".gif" 'strGIFname = ThisWorkbook.Path & "\Excel " & Selection.Name & ".gif" Charts.Add ActiveChart.ChartType = xlXYScatter ActiveChart.Location Where:=xlLocationAsObject, Name:=strCurrentSheet ActiveChart.HasLegend = False ActiveWindow.Visible = False ActiveSheet.ChartObjects(intExistingCharts + 1).Left = 0 ActiveSheet.ChartObjects(intExistingCharts + 1).Top = 0 ActiveSheet.ChartObjects(intExistingCharts + 1).Height = intShapeHeight + 8 ActiveSheet.ChartObjects(intExistingCharts + 1).Width = intShapeWidth + 8 ActiveSheet.Shapes(intI).Copy ActiveSheet.ChartObjects(intExistingCharts + 1).Activate ActiveChart.ChartArea.Select ActiveChart.Paste Application.CutCopyMode = False Set objCurrentShape = ActiveSheet.ChartObjects(intExistingCharts + 1).Chart objCurrentShape.Export FileName:=strGIFname, FilterName:="GIF" ActiveSheet.ChartObjects(intExistingCharts + 1).Delete End If Next intI ActiveSheet.Shapes(strTempShape).Delete Range("A1").SelectEnd SubGruss Norbert

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: