Re: VB: Schwerer Fehler
23.04.2003 10:22:15
ToniS
Hi! Das steht in "Diese Arbeitsmappe":Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Anz = Worksheets.Count
For z = 1 To Anz
Worksheets(z).Activate
Prüfung 'Sub,welches Zellen auf falsche Eingaben prüft'
Next
Fehler = Worksheets(1).Range("S1") + Worksheets(2).Range("S1") + Worksheets(3).Range("S1") + Worksheets(4).Range("S1") + Worksheets(5).Range("S1") + Worksheets(6).Range("S1")
For z = 1 To Anz
Worksheets(z).Activate
ActiveSheet.Range("S1").ClearContents
Next
MsgBox ("Prüfung beendet: " & Fehler & " Korrektur(en) .")
End Sub
Hier noch was im Modul steht:
Sub Prüfung()
k = 0
'Aktives Tabellenblatt wird ermittelt
Aktiv = ActiveSheet.Name
'****************************************************************************
'Beginn der Prüfung
For i = 2 To 1000
FalscheZelle = "Nein"
'Auslesen des Zelleninhalts
Set Inhalt = Worksheets(Aktiv).Cells(i, 2)
If Inhalt <> "" Then
'Anzahl an Stellen wird ermittelt
AnzahlZeichen = Len(Inhalt)
'Schreiben der einzelnen Stellen in Zellen als Zwischenablage
For j = 1 To AnzahlZeichen
Worksheets(Aktiv).Cells(j, 14) = Mid(Inhalt, j, 1)
Next
'Bezeichnen der einzelnen Stellen
Set St1 = Worksheets(Aktiv).Cells(1, 14)
Set St2 = Worksheets(Aktiv).Cells(2, 14)
Set St3 = Worksheets(Aktiv).Cells(3, 14)
Set St4 = Worksheets(Aktiv).Cells(4, 14)
Set St5 = Worksheets(Aktiv).Cells(5, 14)
Set St6 = Worksheets(Aktiv).Cells(6, 14)
Set St7 = Worksheets(Aktiv).Cells(7, 14)
Set St8 = Worksheets(Aktiv).Cells(8, 14)
Set St9 = Worksheets(Aktiv).Cells(9, 14)
Set St10 = Worksheets(Aktiv).Cells(10, 14)
Set St11 = Worksheets(Aktiv).Cells(11, 14)
Set St12 = Worksheets(Aktiv).Cells(12, 14)
Set St13 = Worksheets(Aktiv).Cells(13, 14)
Set St14 = Worksheets(Aktiv).Cells(14, 14)
Set St15 = Worksheets(Aktiv).Cells(15, 14)
If St1 <> "A" Then
FalscheZelle = "Ja"
ElseIf St2 <> " " Then FalscheZelle = "Ja"
ElseIf St3.Value = " " Then FalscheZelle = "Ja"
ElseIf St4.Value = " " Then FalscheZelle = "Ja"
ElseIf St5.Value = " " Then FalscheZelle = "Ja"
ElseIf St6 <> " " Then FalscheZelle = "Ja"
ElseIf St7.Value = " " Then FalscheZelle = "Ja"
ElseIf St8.Value = " " Then FalscheZelle = "Ja"
ElseIf St9.Value = " " Then FalscheZelle = "Ja"
ElseIf St10 <> " " Then FalscheZelle = "Ja"
ElseIf St11.Value = " " Then FalscheZelle = "Ja"
ElseIf St12.Value = " " Then FalscheZelle = "Ja"
ElseIf St13 <> " " Then FalscheZelle = "Ja"
ElseIf St14.Value = " " Then FalscheZelle = "Ja"
ElseIf St15.Value = " " Then FalscheZelle = "Ja"
ElseIf AnzahlZeichen > 15 Then FalscheZelle = "Ja"
End If
If FalscheZelle = "Ja" Then
'Schreiben von Text, Adresse und und Name des Tabellenblatts in Zwischenablage
InhaltAdd = Mid(Inhalt.Address, 2, 1) & Mid(Inhalt.Address, 4, 4)
Worksheets(Aktiv).Range("O1") = ActiveSheet.Name
Worksheets(Aktiv).Range("P1") = InhaltAdd
Worksheets(Aktiv).Range("Q1") = Inhalt
Worksheets(Aktiv).Range("R1") = Inhalt.Address
'Schreiben in TextBox 1-3
UserForm1.TextBox1 = ActiveSheet.Range("Q1")
UserForm1.TextBox2 = ActiveSheet.Range("O1")
UserForm1.TextBox3 = ActiveSheet.Range("P1")
'Einblenden der UserForm
UserForm1.Show
FalscheZellen = "Ja"
k = k + 1
i = i - 1
End If
End If
Next
'Löschen der Einträge in Spalte 14
For j = 1 To 16
Worksheets(Aktiv).Cells(j, 14).Clear
Next
'Schreiben der Anzahl an Änderungen in Zelle als Zwischenablage
Worksheets(Aktiv).Range("S1") = k
End Sub