ComputerBase Menü
Aktuelles

Mit VBA Inhaltsüberprüfung durchführen

D

DjangOC

Lt. Commander
Registriert
Sep. 2013
Beiträge
1.636
Hallo miteinander

Ich muss im Unternehmen jeweils Tagesberichte erstellen, die danach in die FiBu importiert werden.
Um Fehlerquellen auszuräumen, habe ich mir ein Makro geschrieben, tut so weit seinen Job.
Nur hat es nach wie vor eine Fehlerquelle, die ich noch nicht beseitigen konnte. Und zwar muss man das Datum mitgeben. In meiner Referenzvorlage habe ich dazu "=heute()" stehen, da. Nun wollte ich gerne mit folgendem Codeschnipsel abfragen, ob dort das Datum angepasst wurde, und dass sonst das Makro abgebrochen wird.

Code: 
'  Überprüft, ob das Datum angepasst wurde.
    If Range("B2").Select = "=heute()" Then
        MsgBox "Datum anpassen! Makro abgebrochen"
        End
    ElseIf Range("B2").Select = "=HEUTE()" Then
        MsgBox "Datum anpassen! Makro abgebrochen"
        End
    Else
    End If

Meine Erwartung wäre, dass damit nun der ganze Code beendet wird. Aber dem ist nicht so.
Kann mir echt jemand sagen, was ich falsch mache?
Code: 
Sub SB_PaS_TB_M2()
'
' Sagibeiz Makro
'
' Tastenkombination: Strg+Umschalt+S
'
' Überprüft, ob das Datum angepasst wurde.
    If Range("B2").Select = "=heute()" Then
        MsgBox "Datum anpassen! Makro abgebrochen"
        End
    ElseIf Range("B2").Select = "=HEUTE()" Then
        MsgBox "Datum anpassen! Makro abgebrochen"
        End
    Else
    End If
' Verschiebt für Buchung relevanter Inhaltsbereich um eine Zelle nach unten.
    Range("A1:H19").Select
    Range("H19").Activate
    Selection.Cut Destination:=Range("A2:H22")
' Wählt den Bereich A1:C1 aus, und verbindet ihn.
    Range("A1:C1").Select
    Range("C1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
' Schreibt den Titel in die nun verbundene Titelzelle.
    Range("A1").Select
    Range("A1").Activate
    ActiveCell.FormulaR1C1 = "TAGESBERICHT SAGIBEIZ"
' Wählt den Bereich F1:G1 aus, und verbindet ihn.
    Range("F1:G1").Select
    Range("G1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
' Wählt den Bereich F1 aus, und schreibt "Erstellt am:" hinein.
    Range("F1").Select
    Range("F1").Activate
    ActiveCell.FormulaR1C1 = "Erstellt am:"
' Wählt den Bereich H1 aus, und schreibt die Funktion für das aktuelle/heutige Datum hinein hinein.
    Range("H1").Select
    Range("H1").Activate
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Selection.UnMerge
' Wählt den Bereich der ersten Zeile mit Inhalten aus, und macht dessen Schrift grösser und fett.
    Range("A1:H1").Select
    Range("H1").Activate
    Selection.Font.Size = 14
    Selection.Font.Bold = True
' Wählt den für Buchung relevanter Inhaltsbereich aus, und definiert die Querlinien.
    Range("A2:H20").Select
    Range("H20").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
' Wählt den Bereich der ersten Zeile mit Inhalten aus, und macht eine fette Underline-Linie.
    Range("A1:H1").Select
    Range("H1").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
' Wählt den Bereich der ersten Zeile mit Inhalten aus, und macht den Hintergrund schwarz und die Schrift weiss.
    Range("A1:H1").Select
    Range("H1").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
' Druckt den Bericht, mit angepasster Skalierung aus.
    Range("A1:H20").Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = -2
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
' Löscht die erste Zeile.
    Range("A1:H1").Select
    Selection.ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
' Setzt die Formatierung der ersten Zeile zurück.
    Range("A1:H1").Select
    Selection.UnMerge
' Markiert den für die Buchungen relevanten Bereich und verschiebt in zurück.
    Range("A2:H20").Select
    Range("H20").Activate
    Range("A2:H20").Cut Destination:=Range("A1:H19")
    Range("A1:H19").Select
' Entfernt sämtliche Trennlinien.
    Range("A1:H22").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
' Speichert die Datei als Kopie als ".csv" im vorgesehen Verzeichnis ab, mit Datum aus Zelle.
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs "C:\Users\dr\Documents\Gastrofix\Sagibeiz\offen\Makro Gastrofix Sagibeiz " & Range("B2").Value & ".csv", FileFormat:= _
        xlCSVUTF8, CreateBackup:=False
    ActiveWorkbook.Close
    MsgBox "Dateiname: Makro Gastrofix Sagibeiz " & Range("B2").Value & vbLf & vbLf & strDateiname, vbOKOnly + vbInformation, "Datei wurde gespeichert:"
' Kopiert die Referenz ins Arbeitsblatt.
    Sheets("Referenz").Select
    Range("A1:H19").Select
    Range("H19").Activate
    Selection.Copy
    Sheets("Arbeitsblatt").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

Ach und, warum gibt es in der Fuss- und/oder Kopfzeile ab und an den Pfad an?

Gruss und Danke

Edit: Funzt auch mit =today() anstelle von =heute() nicht.
 
Zuletzt bearbeitet:
versuch es mal mit =date

und anstelle "End" nimmt man glaube "End Sub" oder "exit" :) noch besser ein goto:

Gruß
 
Zuletzt bearbeitet:
Hi, Danke für deine Antwort.

End Sub geht, meiner Kenntnis nach dort nicht, habs schon ausprobiert, und macht dann nen Fehler. - If Block ohne End if-
Exit probiere ich gleich mal aus.

Das mit dem "=date" check ich nicht, es muss ja ein Datum sein, aber es darf nicht das "=heute" sein, da dass der Vorlagenwert ist.

Edit: Exit geht auch nicht.
Es bringt auch nichts, wenn ich das ganze danach ins else reinpacke.

Edit2: Das GoTo schein eigentlich die sauberste Lösung zu sein, (eventuell sollte ich noch die if else durch select case anpassen), allerdings tut's immer noch nicht.

Edit3:
Also mit
Code: 
If Sheets("Arbeitsblatt").Range("B2").Value <> "" Then
        MsgBox "Datum anpassen! Makro abgebrochen!"
        GoTo Ende
    ElseIf Sheets("Arbeitsblatt").Range("B2").Value = "=TODAY()" Then
        MsgBox "Datum anpassen! Makro abgebrochen"
        GoTo Ende
    ElseIf Sheets("Arbeitsblatt").Range("B2").Value = "=heute()" Then
        MsgBox "Datum anpassen! Makro abgebrochen"
        GoTo Ende
    ElseIf Sheets("Arbeitsblatt").Range("B2").Value = "=HEUTE()" Then
        MsgBox "Datum anpassen! Makro abgebrochen"
        GoTo Ende
    Else
    End If
Bekomme ich schon mal die Nachricht und den Abbruch hin, es muss also wohl am Ansprechen der =heute() inhalte liegen.

Edit4:
Ich könnt mir grad so eins klatschen, ich muss das Date (logischerweise) ohne "" verwenden dann funzts.

Also so:
Code: 
If Sheets("Arbeitsblatt").Range("B2").Value = Date Then
        MsgBox "Datum anpassen! Makro abgebrochen!"
        GoTo Ende
    Else
    End If
 
Zuletzt bearbeitet:
schön, dass es mit =date doch geht :)

du kannst statt goto "exit sub" versuchen.

warum du allerdings nicht einfach das Datum direkt reinschreibst, wenn du abfragst, ob es "heute" ist, versteh ich nicht :) wenn du kein festes Datum, sondern die Formel "=heute()" in die Zelle schreiben willst, kannst du
Range("b2").FormulaLocal = "=heute()"
Zum Vergrößern anklicken....
versuchen. dein aktuelles Makro sieht ja vor, dass du das manuell änderst, oder?
 
Hi, das Ding ist, für jeden Wochentag muss ein Tagesabschluss erstellt werden.
Ich bin allerdings nur Di bis Fr da.
Da die Tagesberichte also immer in der Vergangenheit liegen, habe ich in der ersten Referenzzelle im Arbeitsblatt =heute() drin, so dass im Falle dessen, dass ich das vergesse anzupassen, nicht ein anderer Bericht überschrieben wird. Diese Sicherheit lässt allerdings nur ein Fehler zu, und ist ausserdem nicht direkt wahrnehmbar. So wie es jetzt ist, kann der Fehler beliebig oft passieren, da er ja nie passiert, respektive immer direkt bemerkt wird.

Die GoTo Sache finde ich jetzt eigentlich doch gerade sehr galant. Ich glaube ich lasses so.
 
Du musst dich einloggen oder registrieren, um hier zu antworten.

Ähnliche Themen

H
SQL Innerhalb einer Abfrage nach Bedarf eine Berechnung durchführen
Antworten
4
Aufrufe
1.426
cloudman
C
michaeldr
VBA Inhalt kopieren
Antworten
5
Aufrufe
1.265
michaeldr
michaeldr
D
Excel/vba: for while mit arrays anstelle diverser if else?
Antworten
7
Aufrufe
2.163
Janush
Janush
F
VisualBasic VBS erstellt 1.xls -> in 1.xls ein VBA aus anderer *.xls durchführen
Antworten
4
Aufrufe
2.396
felix_gorgas
F
Zurück
Oben

Willkommen auf ComputerBase!

Mit Werbung weiterlesen

Besuche ComputerBase wie gewohnt mit Werbung und Tracking. Die Zustimmung ist jederzeit widerrufbar.

Details im Privacy Center und in der Liste unserer Partner. Ein Widerruf ist möglich in der Datenschutzerklärung.

… oder ComputerBase Pro bestellen

Nutze ComputerBase ohne Werbebanner, Video-Ads und Werbetracking schon für 4 €/Monat oder 36 €/Jahr.

Mehr zu ComputerBase Pro

Bereits Pro-Nutzer? Hier anmelden.

Tracking: Wir und unsere 160 Partner verarbeiten personenbezogene Daten, indem wir mit auf Ihrem Gerät gespeicherten Informationen (z. B. eindeutige Kennungen in Cookies) ein Nutzungsprofil erstellen, um z. B. Anzeigen zu personalisieren. Verarbeitungszwecke: Genaue Standortdaten und Abfrage von Geräteeigenschaften zur Identifikation, Informationen auf einem Gerät speichern und/oder abrufen, Personalisierte Anzeigen und Inhalte, Anzeigen- und Inhaltsmessungen, Erkenntnisse über Zielgruppen und Produktentwicklungen.

Impressum Kontakt Datenschutz