Controle voor verzenden

[kloosterofobie]

Beste lezer,

Momenteel ben ik bezig om het wedstrijdprogramma voor ons plaatselijke fc te maken. Ik wil dit programma automatisch gaan versturen middels een knop en dat is gelukt.

Nu wil ik alleen nog de rijen controleren of alles is ingevuld. Mocht iets niet ingevuld zijn dient er een melding te komen van ".... niet ingevuld. Bericht NIET verzonden."

Kan iemand mij op weg helpen?

Groeten,

Jeroen

 

[Warme bakkertje]

Sub tst()
    For Each cl In Range("A8:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If WorksheetFunction.CountA(cl.Resize(, 11)) <> 10 Then MsgBox "Regel " & cl.Row & _
                " is niet volledig ingevuld" & vbLf & "Het bericht is NIET verzonden"
    Next
End Sub

 

[kloosterofobie]

Allereerst Warme Bakkertje bedankt voor je reactie. Dit is inderdaad wat ik bedoel. Ik heb de code nu verwerkt in mij oorspronkelijke code en dan gebeurt er toch iets wat ik niet wil.

De controle loopt en geeft de melding dat er een regel niet volledig is ingevuld. Echter gaat wordt het programma toch verzonden. Het is dus de bedoeling dat indien 1 van de regels niet volledig is ingevuld dat het bericht niet wordt verzonden.

Kan iemand mij even de goede richting opduwen met wat ik moet aanpassen?

Private Sub CommandButton1_Click()

'Working in 97-2010
     Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim wbname As String
    
Dim Answer As String
Dim MyNote As String
Application.ScreenUpdating = False

    'Place your text here
    MyNote = "Weet je zeker dat je het wedstrijdprogramma wilt verzenden?"

    'Display MessageBox
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Bevestigen")

    If Answer = vbNo Then
        'Code for No button Press
        MsgBox "Het wedstrijdprogramma is NIET verzonden!"
   
 Else
    For Each cl In Range("A8:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If WorksheetFunction.CountA(cl.Resize(, 11)) <> 10 Then MsgBox "Regel " & cl.Row & _
                " is niet volledig ingevuld" & vbLf & "Het bericht is NIET verzonden!"


    Set wb = ActiveWorkbook

    If Val(Application.Version) >= 12 Then
        If wb.FileFormat = 51 And wb.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If

    On Error Resume Next
    For I = 1 To 1
        wb.SendMail "1@2.3", _
                    Sheets("Wedstrijdprogramma").Range("Q8").Value
        If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
Next
End If

End Sub

 

[ExcelAmateur]

kloosterofobie,

Werkt het zo wel goed?
Ik heb er Excit sub bij gezet.

Private Sub CommandButton1_Click()
'Working in 97-2010
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wbname As String
Dim Answer As String
Dim MyNote As String
Application.ScreenUpdating = False

    'Place your text here
    MyNote = "Weet je zeker dat je het wedstrijdprogramma wilt verzenden?"

    'Display MessageBox
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Bevestigen")

    If Answer = vbNo Then
        'Code for No button Press
        MsgBox "Het wedstrijdprogramma is NIET verzonden!", vbOKOnly, "Verzending is Afgebroken!"
    Else
        For Each cl In Range("A8:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If WorksheetFunction.CountA(cl.Resize(, 11)) <> 10 Then MsgBox "Regel " & cl.Row & _
                " is niet volledig ingevuld" & vbLf & "Het bericht is NIET verzonden", vbOKOnly, "Verzending is Afgebroken!"
    Exit Sub
    Next
    
    Set wb = ActiveWorkbook

    If Val(Application.Version) >= 12 Then
        If wb.FileFormat = 51 And wb.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If

    On Error Resume Next
    For I = 1 To 1
        wb.SendMail "1@2.3", _
                    Sheets("Wedstrijdprogramma").Range("Q8").Value
        If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
End If
End Sub

 

[kloosterofobie]

Nee zo werkt hij niet want hij breekt nu af ook als alles is ingevuld. Het lijkt me dat er iets met Else of If moet komen maar kan zo niet bedenken hoe ik dat in elkander moet bakken.

 

[Warme bakkertje]

Private Sub CommandButton1_Click()
'Working in 97-2010
Dim wb As Workbook
Application.ScreenUpdating = False
    If MsgBox("Weet je zeker dat je het wedstrijdprogramma wilt verzenden?", vbQuestion + vbYesNo, "Bevestigen") = vbNo Then
            MsgBox "Het wedstrijdprogramma is NIET verzonden!", vbOKOnly, "Verzending is Afgebroken!": Exit Sub
    End If
    For Each cl In Range("A8:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If WorksheetFunction.CountA(cl.Resize(, 11)) <> 10 Then MsgBox "Regel " & cl.Row & _
                " is niet volledig ingevuld" & vbLf & "Het bericht is NIET verzonden", vbOKOnly, "Verzending is Afgebroken!": Exit Sub
        
    Next
    Set wb = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
        If wb.FileFormat = 51 And wb.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If
    On Error Resume Next
    For I = 1 To 1
        wb.SendMail "1@2.3", _
                    Sheets("Wedstrijdprogramma").Range("Q8").Value
        If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
Application.ScreenUpdating = True
End Sub

 

[Joske2000]

Waarom ben je hier niet verder gegaan ?

http://www.helpmij.nl/forum/showthread.php/563704-Wedstrijdprogramma-alleen-verzenden-als-alles-is-ingevuld

Joske