Herbers Excel-Forum - das Archiv
Pflichtfelder mit Prüfung und Meldung
Betrifft: Pflichtfelder mit Prüfung und Meldung
von: EXoTEc
Geschrieben am: 14.10.2003 09:46:03
Hallo, habe eine Excel Datei wo Pflichtfelder ausgefüllt werden müssen. Die vorarbeit hat schon jemand anders gemacht, wenn man auf drucken klickt erscheint die meldung das noch nicht alle Felder ausgefüllt wurden. Die Erweiterung soll jetzt sein das die Meldung angibt welche Felder noch nicht ausgefüllt sind. Ich habe leider keine Ahnung wie ich das machen soll, da ich nicht programmieren kann, bitte helft mir ! Hier ist der code vom Vorgänger:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = True
End Sub
Public Sub Workbook_BeforePrint(Cancel As Boolean)
Dim PruefIndexSeite1 As Integer
Dim PruefIndexSeite2 As Integer
Dim MsgTitel, MSGTEXT As String
MsgTitel = "Überprüfen der Eintragungen des Finanzierungsantrages vor Druck"
PruefIndexSeite1 = Worksheets("Pruefung").Range("B1").Value
PruefIndexSeite2 = Worksheets("Pruefung").Range("E1").Value
If PruefIndexSeite1 = 0 And PruefIndexSeite2 = 0 Then
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = True
Exit Sub
End If
If PruefIndexSeite1 > 0 Or PruefIndexSeite2 > 0 Then
MsgBox "Auf der Seite 1 fehlen noch " & PruefIndexSeite1 & " Eintragungen" & Chr(10) _
& "und/oder auf der Seite 2 fehlen noch " & PruefIndexSeite2 & " Eintragungen" & Chr(10) _
& "des Finanzierungsantrages ! " & Chr(10) _
& "Bitte überprüfen Sie diese !", vbCritical, MsgTitel
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = False
Cancel = True
Exit Sub
End If
End Sub
Private Sub Workbook_Open()
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = False
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim PruefIndexSeite1_1 As Integer
Dim PruefIndexSeite2_2 As Integer
PruefIndexSeite1_1 = Worksheets("Pruefung").Range("B1").Value
PruefIndexSeite2_2 = Worksheets("Pruefung").Range("E1").Value
If PruefIndexSeite1_1 = 0 And PruefIndexSeite2_2 = 0 Then
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = True
Else
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = False
End If
End Sub
Betrifft: AW: Pflichtfelder mit Prüfung und Meldung
von: Dirk
Geschrieben am: 14.10.2003 10:02:47
Hallo.
So wie ich den Code verstehe hat Dein Vorgänger eine Abfrage ins Tabellenblatt "Prüfung" eingearbeitet. Ich geh mal davon aus, das in den Feldern "B1" und "E1" sowas wie eine "zählenwenn"-Funktion liegt. Darin sind dann wohl auch die Bezüge zu den Pflichtfeldern zu finden, die man dann abfragen und bei "Nicht-Ausfüllung" auch explizit angeben kann.
Betrifft: AW: Pflichtfelder mit Prüfung und Meldung
von: EXoTEc
Geschrieben am: 14.10.2003 10:24:42
Ja genau, du hast es richtig verstanden, es soll halt nur noch eine Routine rein die augibt welche felder noch ausgefüllt werden müssen. Es sollen die namen der felder ausgegeben werden die noch nicht ausgefüllt wurden.
https://www.herber.de/bbs/user/1416.xls
Betrifft: AW: Pflichtfelder mit Prüfung und Meldung
von: Dirk
Geschrieben am: 14.10.2003 10:47:10
Hallo.
Ich hoffe es klappt. Tausche einfach die
Sub aus. Is aber leider nur ne Schnell-Lösung.
Public
Sub Workbook_BeforePrint(Cancel As Boolean)
Dim PruefIndexSeite1 As Integer
Dim PruefIndexSeite2 As Integer
'Dim MsgTitel, MSGTEXT As String
'MsgTitel = "Überprüfen der Eintragungen des Finanzierungsantrages vor Druck"
PruefIndexSeite1 = Worksheets("Pruefung").Range("B1").Value
PruefIndexSeite2 = Worksheets("Pruefung").Range("E1").Value
If PruefIndexSeite1 = 0 And PruefIndexSeite2 = 0 Then
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = True
Exit Sub
End If
For i = 2 To 44
If Worksheets("Pruefung").Range("B" & i).Value = 1 Then
MsgBox ("Auf Blatt eins fehlt noch die Angabe zu " & Worksheets("Pruefung").Range("A" & i).Value & ".")
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = False
Cancel = True
Exit Sub
End If
Next i
For j = 2 To 60
If Worksheets("Pruefung").Range("D" & i).Value = 1 Then
MsgBox ("Auf Blatt zwei fehlt noch die Angabe zu " & Worksheets("Pruefung").Range("C" & i).Value & ".")
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = False
Cancel = True
Exit Sub
End If
Next i
End Sub

 |
Betrifft: AW: Pflichtfelder mit Prüfung und Meldung
von: EXoTEc
Geschrieben am: 14.10.2003 11:52:25
Super, vielen dank für deine Hilfe. Hier ist die komplette lösung:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = True
End Sub
Public Sub Workbook_BeforePrint(Cancel As Boolean)
Dim PruefIndexSeite1 As Integer
Dim PruefIndexSeite2 As Integer
Dim MELDUNGTEXT, MELDUNGTEXT1 As String
Dim MsgTitel, MSGTEXT As String
MELDUNGTEXT = "Fehlende Eintragungen auf Seite 1" & Chr(10) & "-------------------------------------------"
MELDUNGTEXT1 = "Fehlende Eintragungen auf Seite 2" & Chr(10) & "------------------------------------------"
MSGTEXT = "Auf der Seite 1 fehlen noch " & PruefIndexSeite1 & " Eintragungen" & Chr(10) _
& "und/oder auf der Seite 2 fehlen noch " & PruefIndexSeite2 & " Eintragungen" & Chr(10) _
& "des Finanzierungsantrages ! " & Chr(10) _
& "Bitte überprüfen Sie diese !"
MsgTitel = "Überprüfen der Eintragungen des Finanzierungsantrages vor Druck"
PruefIndexSeite1 = Worksheets("Pruefung").Range("B1").Value
PruefIndexSeite2 = Worksheets("Pruefung").Range("E1").Value
If PruefIndexSeite1 = 0 And PruefIndexSeite2 = 0 Then
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = True
End If
For i = 2 To 44
If Worksheets("Pruefung").Range("B" & i).Value = 1 Then
MELDUNGTEXT = MELDUNGTEXT & Chr(10) & Worksheets("Pruefung").Range("A" & i).Value
End If
Next i
For i = 2 To 60
If Worksheets("Pruefung").Range("E" & i).Value = 1 Then
MELDUNGTEXT1 = MELDUNGTEXT1 & Chr(10) & Worksheets("Pruefung").Range("D" & i).Value
End If
Next i
If PruefIndexSeite1 > 0 Or PruefIndexSeite2 > 0 Then
MsgBox MELDUNGTEXT & Chr(10) & MELDUNGTEXT1, vbCritical, MsgTitel
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = False
Cancel = True
Exit Sub
End If
End Sub
Private Sub Workbook_Open()
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = False
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim PruefIndexSeite1_1 As Integer
Dim PruefIndexSeite2_2 As Integer
PruefIndexSeite1_1 = Worksheets("Pruefung").Range("B1").Value
PruefIndexSeite2_2 = Worksheets("Pruefung").Range("E1").Value
If PruefIndexSeite1_1 = 0 And PruefIndexSeite2_2 = 0 Then
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = True
Else
Application.CommandBars("Worksheet Menu Bar").Controls("Datei").Controls("Senden an").Enabled = False
End If
End Sub