BeforePrint in Klassenmodul in Add-In
01.07.2008 12:52:00
Danny
Während der Verwendung verselbstständigt sich Excel und es treten äußerst seltsame Ergebnisse auf.
Beim ersten Schleifendurchlauf (1. Tabellenblatt) schreibt das Makro noch die richtigen Werte in die Fußzeile. Ab dem zweiten Durchlauf ist alles durcheinander.
Vielleicht versteht ein Makro-Experte warum Excel im nachfolgenden Code falsche Ergebnisse liefert.
Schon im Voraus vielen Dank für die Antworten.
Hier noch der Code aus dem Klassenmodul:
Option Explicit
Private Fusszeilelinks As String, Fusszeilemitte As String, Fusszeilerechts As String
Private i As Integer, n, j As Integer, Länge As Integer
Private Mappe As String
Public WithEvents App As Application
Private Sub App_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Pfad As String, PfadUNC As String
Dim TextFußzeile As String, Fusszeilemitte As String, fußzeilerechts As String
Dim gefunden As Boolean
Dim k As Integer
'Dim Fusszeilelinks As String
'Variablen Kürzel
Dim laenge As Integer
Dim FußzeileRest As String
Dim Anzahl As Byte
Mappe = ActiveWorkbook.Name
Pfad = Workbooks(Mappe).Path
PfadUNC = PfadNachUnc(Pfad)
i = Workbooks(Mappe).Sheets.Count
For n = 1 To i
TextFußzeile = Workbooks(Mappe).Sheets(n).PageSetup.CenterFooter
Fusszeilelinks = Workbooks(Mappe).Sheets(n).PageSetup.LeftFooter
Select Case TextFußzeile
Case ""
'Prüfung, ob die Datei gespeichert ist
If Pfad = "" _
Then
'Datei nicht gespeichert
'Call Kürzel
Fusszeilelinks = Workbooks(Mappe).Sheets(n).PageSetup.LeftFooter
laenge = Len(Fusszeilelinks)
Anzahl = 0
For j = 1 To laenge
If IsNumeric(Mid(Fusszeilelinks, j, 1)) = True _
Then
Anzahl = Anzahl + 1
FußzeileRest = Mid(Fusszeilelinks, j + 1, laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, j - 1) & "6" & _
_
_
_
_
_
FußzeileRest
Else
End If
Next
If Anzahl > 1 _
Then
For j = 1 To laenge
If Mid(Fusszeilelinks, j, 2) = 66 _
Then
FußzeileRest = Mid(Fusszeilelinks, j + 2, _
laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, j) & Fuß _
_
_
_
_
_
zeileRest
Exit For
Else
End If
Next
Else
End If
Workbooks(Mappe).Sheets(n).PageSetup.LeftFooter = Fusszeilelinks
'End Kürzel
Pfad = "\"
Workbooks(Mappe).Sheets(n).PageSetup.CenterFooter = "&""Arial""&6" & _
Pfad & "\" & "&F.&A"
Workbooks(Mappe).Sheets(n).PageSetup.RightFooter = "&""Arial""&6" & " _
Seite" & "&P/&N"
Pfad = ""
Else
'Datei gespeichert'
'Call Kürzel
Fusszeilelinks = Workbooks(Mappe).Sheets(n).PageSetup.LeftFooter
laenge = Len(Fusszeilelinks)
Anzahl = 0
For j = 1 To laenge
If IsNumeric(Mid(Fusszeilelinks, j, 1)) = True _
Then
Anzahl = Anzahl + 1
FußzeileRest = Mid(Fusszeilelinks, j + 1, laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, j - 1) & "6" & _
_
_
_
_
_
FußzeileRest
Else
End If
Next
If Anzahl > 1 _
Then
For j = 1 To laenge
If Mid(Fusszeilelinks, j, 2) = 66 _
Then
FußzeileRest = Mid(Fusszeilelinks, j + 2, _
laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, j) & Fuß _
_
_
_
_
_
zeileRest
Exit For
Else
End If
Next
Else
End If
Workbooks(Mappe).Sheets(n).PageSetup.LeftFooter = Fusszeilelinks
'Ende Kürzel
Workbooks(Mappe).Sheets(n).PageSetup.CenterFooter = "&""Arial""&6" & _
PfadUNC & "\" & "&F.&A"
Workbooks(Mappe).Sheets(n).PageSetup.RightFooter = "&""Arial""&6" & " _
Seite" & "&P/&N"
End If
Case Else
'Prüfung, ob Fußzeile einen Pfad enthält
gefunden = False
For i = 1 To Len(TextFußzeile)
If Mid(TextFußzeile, i, 1) = "\" _
Then
gefunden = True
Exit For
End If
Next
If gefunden = True _
Then
'Datei enthält Pfad, ggf. Pfad-Aktualiesierung
'Call Kürzel
Fusszeilelinks = Workbooks(Mappe).Sheets(n).PageSetup.LeftFooter
laenge = Len(Fusszeilelinks)
Anzahl = 0
For j = 1 To laenge
If IsNumeric(Mid(Fusszeilelinks, j, 1)) = True _
Then
Anzahl = Anzahl + 1
FußzeileRest = Mid(Fusszeilelinks, j + 1, laenge - j)
'test
Fusszeilelinks = Mid(Fusszeilelinks, 1, j - 1) & Mid(""" _
_
_
_
_
_
", 1, 2) & Mid("""", 1, 1) & "Arial" & Mid("""", 1, 2) & Mid("""", 1, 1) & "&6" & FußzeileRest
Fusszeilemitte = "&""Arial""&6" & PfadUNC & "\" & "&F.& _
_
_
_
_
_
A"
Fusszeilerechts = "&""Arial""&6" & "Seite" & "&P/&N"
'&""Arial""&6" & Abteilung & " " & "&D &T
Else
End If
Next
If Anzahl > 1 _
Then
For j = 1 To laenge
If Mid(Fusszeilelinks, j, 2) = 66 _
Then
FußzeileRest = Mid(Fusszeilelinks, j + 2, _
laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, j) & Fuß _
_
_
_
_
_
zeileRest
Exit For
Else
End If
Next
Else
End If
Hier treten meistens die Probleme auf.
Die Variablenwerte stimmen, Excel interpretiert sie selbstständig _
_
b>
Workbooks(Mappe).Sheets(n).PageSetup.LeftFooter = Fusszeilelinks
'Ende Kürzel
Workbooks(Mappe).Sheets(n).PageSetup.CenterFooter = Fusszeilemitte
Workbooks(Mappe).Sheets(n).PageSetup.RightFooter = Fusszeilerechts
Else
End If
End Select
Next
i = 0
n = Workbooks(Mappe).Charts.Count
If n > 0 _
Then
For i = 1 To n
TextFußzeile = Workbooks(Mappe).Charts(i).PageSetup.CenterFooter
Select Case TextFußzeile
Case ""
'Prüfung, ob die Datei gespeichert ist
If Pfad = "" _
Then
'Datei nicht gespeichert
'Call Kürzel_Diag
Fusszeilelinks = Workbooks(Mappe).Charts(n).PageSetup. _
LeftFooter
laenge = Len(Fusszeilelinks)
Anzahl = 0
For j = 1 To laenge
If IsNumeric(Mid(Fusszeilelinks, j, 1)) = True _
Then
Anzahl = Anzahl + 1
FußzeileRest = Mid(Fusszeilelinks, j + 1, _
laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, j - 1) & _
_
_
_
_
_
"6" & FußzeileRest
Else
End If
Next
If Anzahl > 1 _
Then
For j = 1 To laenge
If Mid(Fusszeilelinks, j, 2) = 66 _
Then
FußzeileRest = Mid(Fusszeilelinks, j + _
_
_
_
_
_
2, laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, _
_
_
_
_
_
j) & FußzeileRest
Exit For
Else
End If
Next
Else
End If
Workbooks(Mappe).Charts(n).PageSetup.LeftFooter = _
Fusszeilelinks
'Ende Kürzel Diag
Pfad = "\"
Workbooks(Mappe).Charts(i).PageSetup.CenterFooter = "&""Arial""& _
_
_
_
_
_
6" & Pfad & "\" & "&F.&A"
Workbooks(Mappe).Charts(i).PageSetup.RightFooter = "&""Arial""& _
_
_
_
_
_
6" & "Seite" & "&P/&N"
Pfad = ""
Else
'Datei gespeichert'
'Call Kürzel_Diag
Fusszeilelinks = Workbooks(Mappe).Charts(n).PageSetup. _
LeftFooter
laenge = Len(Fusszeilelinks)
Anzahl = 0
For j = 1 To laenge
If IsNumeric(Mid(Fusszeilelinks, j, 1)) = True _
Then
Anzahl = Anzahl + 1
FußzeileRest = Mid(Fusszeilelinks, j + 1, _
laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, j - 1) & _
_
_
_
_
_
"6" & FußzeileRest
Else
End If
Next
If Anzahl > 1 _
Then
For j = 1 To laenge
If Mid(Fusszeilelinks, j, 2) = 66 _
Then
FußzeileRest = Mid(Fusszeilelinks, j + _
_
_
_
_
_
2, laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, _
_
_
_
_
_
j) & FußzeileRest
Exit For
Else
End If
Next
Else
End If
Workbooks(Mappe).Charts(n).PageSetup.LeftFooter = _
Fusszeilelinks
'Ende Kürzel Diag
Workbooks(Mappe).Charts(i).PageSetup.CenterFooter = "&""Arial""& _
_
_
_
_
_
6" & PfadUNC & "\" & "&F.&A"
Workbooks(Mappe).Charts(i).PageSetup.RightFooter = "&""Arial""& _
_
_
_
_
_
6" & "Seite" & "&P/&N"
End If
Case Else
'Prüfung, ob Fußzeile einen Pfad enthält
gefunden = False
For k = 1 To Len(TextFußzeile)
If Mid(TextFußzeile, k, 1) = "\" _
Then
gefunden = True
Exit For
End If
Next
If gefunden = True _
Then
'Datei enthält Pfad, ggf. Pfad-Aktualiesierung
'Call Kürzel_Diag
Fusszeilelinks = Workbooks(Mappe).Charts(n).PageSetup. _
LeftFooter
laenge = Len(Fusszeilelinks)
Anzahl = 0
For j = 1 To laenge
If IsNumeric(Mid(Fusszeilelinks, j, 1)) = True _
Then
Anzahl = Anzahl + 1
FußzeileRest = Mid(Fusszeilelinks, j + 1, _
laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, j - 1) & _
_
_
_
_
_
"6" & FußzeileRest
Else
End If
Next
If Anzahl > 1 _
Then
For j = 1 To laenge
If Mid(Fusszeilelinks, j, 2) = 66 _
Then
FußzeileRest = Mid(Fusszeilelinks, j + _
_
_
_
_
_
2, laenge - j)
Fusszeilelinks = Mid(Fusszeilelinks, 1, _
_
_
_
_
_
j) & FußzeileRest
Exit For
Else
End If
Next
Else
End If
Workbooks(Mappe).Charts(n).PageSetup.LeftFooter = _
Fusszeilelinks
'Ende Kürzel Diag
Workbooks(Mappe).Charts(i).PageSetup.CenterFooter = "&""Arial""& _
_
_
_
_
_
6" & PfadUNC & "\" & "&F.&A"
Workbooks(Mappe).Charts(i).PageSetup.RightFooter = "&""Arial""& _
_
_
_
_
_
6" & "Seite" & "&P/&N"
Else
End If
End Select
Next
Else
End If
Application.ScreenUpdating = True
End Sub