Sub Workbook_BeforeSave wird nicht aufgeführt
25.01.2005 16:47:30
Marion
beim Speichern einer Excel Datei sollen die Textlängen der Zellen B25 und B26 überprüft werden in allen Worksheets.
Das hatte bisher auch funktioniert. Jetzt hatte ich die Excel Datei unter einem anderen Namen gespeichert und der Code wird gar nicht mehr ausgeführt, auch keine Test-Messagebox wie Msgbox "Hallo".
An was kann das liegen ?
Vielleicht kann mir jemand weiter helfen.
Viele Grüße und besten Dank
Marion
Hier noch mein VBA-Code im Event Workbook_BeforeSave
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim zeilen1, zeilen2, zeilensumme, zeilensummeD, zeilensummeE, zeileni, anzahl, flag As Long
Dim x As Worksheet
Dim zeilenreal As Single
Dim titel, text As String
Dim teil1, teil2 As String
Dim textproj, textplan As String
flag = 0
For Each x In ThisWorkbook.Sheets ' Schleife über Arbeitsblätter
titel = "Tabellenblatt " + x.Name
' Project Description / Projektbeschreibung
textproj = x.Cells(25, 2)
anzahl = Len(textproj) + 50 ' 50 Zeichen für Umbruch
zeilenreal = anzahl / 77 ' 77 Zeichen pro Zeile möglich
zeileni = CInt(zeilenreal)
If (zeilenreal - zeileni < 0) Then
zeilen1 = zeileni
Else
zeilen1 = zeileni + 1
End If
'Scope of Design Works / Erbrachte Planungsleistung
textproj = x.Cells(26, 2)
If x.Name = "Englisch" Then
anzahl = Len(textproj) + 23 + 10 ' 23 für Scope of ..., 10 für Umbruch
Else
anzahl = Len(textproj) + 28 + 10 ' 28 für Erbrachte ..., 10 für Umbruch
End If
zeilenreal = anzahl / 77 ' 77 Zeichen pro Zeile möglich
zeileni = CInt(zeilenreal) ' Runden auf Ganzzahl
If (zeilenreal - zeileni < 0) Then
zeilen2 = zeileni
Else
zeilen2 = zeileni + 1
End If
' Zeilensumme abspeichern für letzte Messagebox
zeilensumme = zeilen1 + zeilen2
If x.Name = "Englisch" Then
zeilensummeE = zeilensumme
Else
zeilensummeD = zeilensumme
End If
text = "Das Projekt paßt wahrscheinlich nicht auf eine halbe Seite:" + _
Chr(10) + " Der Text in den Zellen B25 und B26 (Projektbeschreibung, Planungsleistung) ist mit " + _
CStr(zeilensumme) + " Zeilen länger als 14 Ausdruckzeilen."
If zeilensumme > 14 Then ' Projekt passt nicht auf eine halbe Seite
MsgBox text, , titel
Else
flag = flag + 1 ' Projekt passt auf eine halbe Seite
End If
Next x
If flag = 2 Then ' also die Textlängen passen alle
titel = " Die Textlängen in den Zellen B25 und B26 sind in beiden Tabellenblättern ok "
text1 = "Die Zellen B25 und B26 (Projektbeschreibung, Planungsleistung) ergeben folgende Zeilenlängen: "
text2 = " Englisch: " + CStr(zeilensummeE) + " , deutsch: " + CStr(zeilensummeD)
text3 = " Zeilen kleiner gleich 14 Zeilen. "
text = text1 + text2 + text3
MsgBox text, , titel
End If
End Sub