Microsoft Excel

Herbers Excel/VBA-Archiv

Speichern Wenn mit zusätzlicher Bedingung


Betrifft: Speichern Wenn mit zusätzlicher Bedingung
von: Liloslotta
Geschrieben am: 29.11.2018 09:08:03

Guten Morgen (:

ich habe schon einiges zum Thema "erst speicher wenn" im Forum gefunden.

Wie z.b.:

Private Sub CommandButton1_Click()
    Dim rngPflicht As Range, rngBereich As Range
    Dim intLeere As Integer
    Set rngPflicht = [F8,F9,F10,F11,F12,F13,F14,F15,F16,F17,F18,F19]
    For Each rngBereich In rngPflicht.Areas
        intLeere = intLeere + Application.WorksheetFunction.CountBlank(rngBereich)
    Next
    If intLeere > 0 Then
        MsgBox "Speichern nur möglich wenn Kommentar ausgefüllt ist!"
    Else
        On Error Resume Next 'Falls Speichern abgebrochen wurde
        If ActiveWorkbook.Saved Then
            ActiveWorkbook.Save
        Else
            Application.Dialogs(xlDialogSaveAs).Show
        End If
    End If
End Sub


Jetzt habe ich noch eine Frage. Ich müsste prüfen, ob das Feld in Bedingung mit O8:O19 (Dort steht WAHR ODER FALSCH) ausgefüllt werden muss?

Könnte mir da jemand weiterhelfen?
Leider habe ich nicht so viel Ahnung von VBA.

Vielen Dank im Voraus !

  

Betrifft: AW: Speichern Wenn mit zusätzlicher Bedingung
von: Piet
Geschrieben am: 29.11.2018 12:04:21

Hallo

du schreibst das im Feld "O8:O19" Wahr oder Falsch stehen muss. Da erhebt sich die Frage was muss da genau stehen, Versuch es mal mit diesem Code, prüfe ob das deine Erwartungen erfüllt. Sonst must du ihn umschreiben. Ich gehe davon aus das alle Zeilen in Spalte O auf WAHR stehen müssen.

rngBereich.Offset(0, 3) bedeutet die Zelle um 3 Spalten nach Rechts versetzt, d.h., prüfe mit IF Then den Wert in Spalte O auf WAHR.

mfg Piet

PS Es kann sein das du im Code statt "True" das Deutsche Wort "WAHR" als Text String angeben must!

Private Sub CommandButton1_Click()
    Dim rngPflicht As Range, rngBereich As Range
    Dim intLeere As Integer
    Dim intWahr As Integer
    Set rngPflicht = [F8,F9,F10,F11,F12,F13,F14,F15,F16,F17,F18,F19]
    For Each rngBereich In rngPflicht.Areas
        intLeere = intLeere + Application.WorksheetFunction.CountBlank(rngBereich)
        If rngBereich.Offset(0, 3) = True Then intWahr = intWahr + 1
    Next
    If intWahr < 12 Then   'Abbruch wenn nicht alle Wahr Zeilen erfüllt sind!!
        MsgBox 12 - intWahr & "  In Spalte O sind nicht alle Wahr Bedinungen erfüllt!"
    ElseIf intLeere > 0 Then
        MsgBox "Speichern nur möglich wenn Kommentar ausgefüllt ist!"
    Else
        On Error Resume Next 'Falls Speichern abgebrochen wurde
        If ActiveWorkbook.Saved Then
            ActiveWorkbook.Save
        Else
            Application.Dialogs(xlDialogSaveAs).Show
        End If
    End If
End Sub