Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Wenn Datum grösser als heute | Herbers Excel-Forum


Betrifft: Wenn Datum grösser als heute von: Heinz H
Geschrieben am: 04.01.2010 13:59:46

Hallo Leute

Im unteren Makro wird mir das Monat um 1 hochgezählt.

Nun möchte ich wenn in H1 das Datum grösser als heute, das dann eine MsgBox Zb. "Sie müssen noch bis zum 1.April warten". erscheint und das Makro beendet.

Könnte mir bitte wieder jemand weiterhelfen ?

Gruß
Heinz

Sub WochenendeWeg(monat As Boolean)
Application.EnableEvents = False
Application.ScreenUpdating = False

   


'-------Monat um 1 Hochzählen----------



'In G1 steht jetzt eine Formel, die nicht mehr geändert werden muss,
            'daher wird nur noch F1 geändert.
If monat = False Then
If MsgBox("Wollen Sie ein neues Monat erstellen ?", vbQuestion + vbYesNo, _
    " Nachfrage Neues Monat erstellen !") = vbNo Then Exit Sub
    
Range("F1") = DateAdd("m", 1, Range("F1"))
End If
Call cp_wbk
'*******************************************************************************************
'Blattname neu bestimmen
ActiveSheet.Name = Range("G1")
   
   Dim datStart As Date, datEnd As Date
   Dim lDay As Long
   Dim iRow As Integer, lngStart As Long, lngCol As Long
   datStart = Range("F1").Value ' in der Zelle M3 befindet sich das Anfangsdatum
   datEnd = Range("H1").Value   ' in der Zelle H1 befindet sich das Enddatum
   iRow = 6 ' Hiermit wird gesagt, dass in Zeile 6 angefangen werden soll
   lngStart = iRow
   
'################################################################################

   
   Range("A6:A35").EntireRow.ClearContents 'Statt löschen der Zeilen werden nur Inhalte gelö _
scht
   Range("C6:F35").EntireRow.ClearContents ' Statt löschen der Zeilen werden nur Inhalte gelö _
scht
   Range("A6:A35").EntireRow.Interior.ColorIndex = xlColorIndexNone 'Franz entfernt Farbe aus  _
Zellbereich
   Range("A6:O35").Font.Bold = False 'Schriftart Fett zurücksetzen
   Range("A6:A35").NumberFormatLocal = "TT.MM.JJJJ"
   Range("B6:B35").NumberFormatLocal = "TTT"


For lDay = datStart To datEnd
  Select Case WeekDay(lDay, 2)
    Case Is < 6
      Cells(iRow, 1) = lDay
      Cells(iRow, 2) = lDay
      iRow = iRow + 1
    Case Is = 6
      Range(Cells(iRow, 1), Cells(iRow, 15)).Interior.ColorIndex = 34
      Range(Cells(iRow, 1), Cells(iRow, 15)).Font.Bold = True
      
      
      For lngCol = 7 To 11
        Cells(iRow, lngCol).Formula = "=Sum(" & Range(Cells(lngStart, lngCol), _
            Cells(iRow - 1, lngCol)).Address & ")"
      Next
      iRow = iRow + 1
      lngStart = iRow
  End Select

Next

Range(Cells(iRow, 1), Cells(iRow, 15)).Interior.ColorIndex = 34
Range(Cells(iRow, 1), Cells(iRow, 15)).Font.Bold = True

For lngCol = 7 To 11
  Cells(iRow, lngCol).Formula = "=Sum(" & Range(Cells(lngStart, lngCol), _
      Cells(iRow - 1, lngCol)).Address & ")"
Next
  
   Dim sp#, Such$, LR%, TB1, i#, m%, Z1%

Dim M1%


Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & _
        Err.Description

Application.EnableEvents = True

Application.ScreenUpdating = True
End Sub


  

Betrifft: Datum grösser als heute von: Rudi Maintaire
Geschrieben am: 04.01.2010 14:25:19

Hallo,
if Range("H1")>Date then
msgbox "Sie müssen noch bis zum " &Format(Range("H1"), "DD.MMMM" &" warten")
Exit Sub
End If

Gruß
Rudi

btw.: Es heißt der Monat.


  

Betrifft: AW: Datum grösser als heute von: Heinz H
Geschrieben am: 04.01.2010 15:03:59

Hallo Rudi

Recht herzlichen DANK.
Funkt. einwandfrei.

Gruß
Heinz