26.05.2022, 22:35
Heje Excelfreunde,
habe mit zwei Macros ein merkwürdiges Problem. Mit dem automatischen Ausführen den jeweiligen Macro's werden leere Bilder eines Tabellenausschnittes erzeugt. Führe ich die Macro's dagegen händisch (Taste F8) durch, dann werden genau die Tabellenausschnitte
als Bilddatei erzeugt und abgelegt. Wo liegt das Problem...
oder das zweite Beispiel
habe mit zwei Macros ein merkwürdiges Problem. Mit dem automatischen Ausführen den jeweiligen Macro's werden leere Bilder eines Tabellenausschnittes erzeugt. Führe ich die Macro's dagegen händisch (Taste F8) durch, dann werden genau die Tabellenausschnitte
als Bilddatei erzeugt und abgelegt. Wo liegt das Problem...
Code:
Sub ExportWorksheetAsPicture()
Dim chtPicture As Chart
Dim strSheetName As String
With Application
.ScreenUpdating = False
strSheetName = ActiveSheet.name
ActiveSheet.Range("A1:w46").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set chtPicture = Charts.Add
chtPicture.Paste
chtPicture.Export ActiveWorkbook.Path & "\" & strSheetName & ".gif"
Application.DisplayAlerts = False
chtPicture.Delete
Application.DisplayAlerts = True
Set chtPicture = Nothing
.ScreenUpdating = True
End With
End Suboder das zweite Beispiel
Code:
Public Sub BildBereichErstellenKopieren()
Dim WStab05 As Worksheet
Dim rngBereich01 As Range
On Error GoTo Fehler
Set WStab05 = ThisWorkbook.Worksheets("Tabelle5")
Set rngBereich01 = WStab05.Range("A1:W46")
With Application
'.ScreenUpdating = False
With ActiveWorkbook
.Unprotect Password:="******"
With WStab05
.Unprotect Password:="******"
rngBereich01.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With WStab05.ChartObjects.Add(0, 0, Range("A1:W46").Width, Range("A1:W46").Height).Chart
.Paste
.Export strKompPath
.Parent.Delete
End With
.Protect Password:="******", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
.Protect Password:="******", Structure:=True, Windows:=False
End With
'.ScreenUpdating = True
End With
On Error GoTo 0
Set WStab05 = Nothing
Set rngBereich01 = Nothing
Exit Sub
Fehler:
If Err.Number > 0 Then
MsgBox "UF7_03 Fehlercode : " + CStr(Err.Number) + " " + Err.Description + " " + CStr(Err.Source)
End If
End Sub
