11.09.2021, 12:35
Hallo Excelfreunde,
das nachfolgende macro hat bisher wunderbar funktioniert. Mit der Umstellung auf excel 2007(32 bit) =>2019(64 bit) funktionier das macro noch
im ablauf, aber es wird kein Bild erzeugt.
Kurz: aus Tabellendaten wird auf einem Tabellenblatt, mit vorbereitetem Bereich, verschiedenen Daten in diesen Bereich geladen. Ein macro wird gestartet und bereiten alles vor (z.B Zieldaten, Dateiname, Verzeichnis usw.). Anschließend kommt das nachfolgenden macro und soll den Bereich
als Bilddatei in einem Verzeichnis abspeichern. das funktioniert auch alles, nur öffnet man die Bilddatei (jpg, png, bmp, gif), dann ist jetzt nur noch eine weise Fläche vorhanden...
das nachfolgende macro hat bisher wunderbar funktioniert. Mit der Umstellung auf excel 2007(32 bit) =>2019(64 bit) funktionier das macro noch
im ablauf, aber es wird kein Bild erzeugt.
Kurz: aus Tabellendaten wird auf einem Tabellenblatt, mit vorbereitetem Bereich, verschiedenen Daten in diesen Bereich geladen. Ein macro wird gestartet und bereiten alles vor (z.B Zieldaten, Dateiname, Verzeichnis usw.). Anschließend kommt das nachfolgenden macro und soll den Bereich
als Bilddatei in einem Verzeichnis abspeichern. das funktioniert auch alles, nur öffnet man die Bilddatei (jpg, png, bmp, gif), dann ist jetzt nur noch eine weise Fläche vorhanden...
Code:
Public Sub MassnahmenBildErzeugen()
Dim WSMB As Worksheet
Dim Zellbereich As Range
Dim strMassnahmeBezName As String
Dim strFileName As String
On Error GoTo Fehler
Set WSMB = ThisWorkbook.Worksheets("MassnahmenBezeichner")
Set Zellbereich = WSMB.Range(mstrBildArg1)
Zellbereich.Select
strMassnahmeBezName = mstrBildArg2 & mstrBildArg3
strFileName = ActiveWorkbook.Path & strMassnahmeBezName & "." + strGrafikformat
Zellbereich.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Application.StatusBar = strFileName
With WSMB.ChartObjects.Add(0, 0, Zellbereich.Width, Zellbereich.Height).Chart
WSMB.Shapes(WSMB.ChartObjects.Count).Line.visible = msoFalse
.Paste
.Export Filename:=strFileName, FilterName:=strGrafikformat
.Parent.Delete
End With
Set Zellbereich = Nothing
On Error GoTo 0
Exit Sub
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & " " & Err.Description
'Resume Next
End Sub
...im Moment finden ich nicht den Weg das zu ändern...
