Re: Excel-Fragen Volume 4!
Geizhals » Forum » Programmierung » Excel-Fragen Volume 4! (21 Beiträge, 165 Mal gelesen) Top-100 | Fresh-100
Du bist nicht angemeldet. [ Login/Registrieren ]
.  Re: Excel-Fragen Volume 4!  (TheTrumpeter am 15.01.2005, 11:15:32)
..  Re(2): Excel-Fragen Volume 4!  (User58746 am 15.01.2005, 11:16:31)
...  Re(3): Excel-Fragen Volume 4!  (TheTrumpeter am 15.01.2005, 11:37:38)
....  Re(4): Excel-Fragen Volume 4!  (User58746 am 15.01.2005, 11:53:23)
....  Re(4): Excel-Fragen Volume 4!  (User58746 am 15.01.2005, 12:02:29)
.....  Re(5): Excel-Fragen Volume 4!  (hariw am 15.01.2005, 12:16:38)
......  Re(6): Excel-Fragen Volume 4!  (User58746 am 15.01.2005, 12:18:34)
.......  Re(7): Excel-Fragen Volume 4!  (hariw am 15.01.2005, 12:35:06)
.......  Re(7): Excel-Fragen Volume 4!  (hariw am 15.01.2005, 12:55:40)
........  Re(8): Excel-Fragen Volume 4!  (User58746 am 16.01.2005, 16:22:06)
.........  Re(9): Excel-Fragen Volume 4!  (hariw am 16.01.2005, 19:35:42)
..........  Re(10): Excel-Fragen Volume 4!  (User58746 am 16.01.2005, 19:45:19)
...........  Re(11): Excel-Fragen Volume 4!  (hariw am 16.01.2005, 20:10:31)
............  Re(12): Excel-Fragen Volume 4!  (User58746 am 16.01.2005, 21:22:40)
.............  Re(13): Excel-Fragen Volume 4!  (hariw am 16.01.2005, 21:25:07)
.....  Re(5): Excel-Fragen Volume 4!  (TheTrumpeter am 15.01.2005, 13:32:31)
......  Re(6): Excel-Fragen Volume 4!  (Suffix am 15.01.2005, 23:37:42)
.......  Re(7): Excel-Fragen Volume 4!  (TheTrumpeter am 16.01.2005, 11:56:51)
.
Re: Excel-Fragen Volume 4!
16.01.2005, 22:31:34
So, mehr aufwand als gedacht ;-)

Option Explicit
'hier die Anzahl der Sheets eingeben (0 der größer als Anzahl der Sheets=alle)
'es wird ab dem ersten gezählt nach links, überspringen ist nicht möglich
Const INTSHEETS = 12
'true eintragen wenn ein Hinweis erscheinen soll, dass keine Zelle mit Datum vorhanden ist
'false wenn einfach weitergemacht werden soll (kein Hinweis)
Const BOLFEHLER = True
Private Sub Workbook_Open()
Dim intCounter As Integer, intTmp As Integer, intSheetCount As Integer
Dim wks As Worksheet
Set wks = ActiveSheet
Application.ScreenUpdating = False
intSheetCount = INTSHEETS
On Error GoTo fehler:
If INTSHEETS > ActiveWorkbook.Worksheets.Count Or INTSHEETS = 0 Then intSheetCount = ActiveWorkbook.Worksheets.Count
For intCounter = 1 To intSheetCount
    intTmp = findCell(ActiveWorkbook.Worksheets(intCounter))
    If intTmp = 0 And BOLFEHLER = True Then
        MsgBox ("Tabelle: " & ActiveWorkbook.Worksheets(intCounter).Name & " enthält keine Zelle mit dem aktuellen Datum, Tabellenblatt übersprungen!")
    End If
Next intCounter
wks.Activate
Exit Sub
Application.ScreenUpdating = True
fehler:
MsgBox Err.Description
Application.ScreenUpdating = True
End Sub
Private Function findCell(wks As Worksheet)
Dim rng As Excel.Range
On Error GoTo Ende:
wks.Activate
If Not wks.Cells.SpecialCells(xlCellTypeFormulas, xlNumbers) Is Nothing Then
    For Each rng In wks.Cells.SpecialCells(xlCellTypeFormulas, xlNumbers)
        If rng.Value = Date Then
            rng.Select
            findCell = 2
            Exit Function
        End If
    Next
ElseIf Not wks.Cells.SpecialCells(xlCellTypeConstants, xlNumbers) Is Nothing Then
    If rng Is Nothing Then
        For Each rng In wks.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
            If rng.Value = Date Then
                rng.Select
                findCell = 2
                Exit Function
            End If
        Next
    End If
End If
Ende:
findCell = 0

End Function


Das Programm musst du im VBA-Editor (Alt+F11), Doppelklick auf die Arbeitsmappe die du willst, Doppelklick auf Arbeitsmappen-Objekte, Doppelklick auf dieseArbeitsmappe einfügen.

Du kannst sowohl die Anzahl der Sheets einstellen (beginnt beim ersten von links zu zählen, zählt Charts etc. nicht dazu), wenn du 0 wählst werden alle durchsucht.
Du kannst weiters auswählen, ob du einen Hinweis möchtest, wenn kein Datumsfeld mit aktuellem Datum drinnen ist oder nicht.


Viel spass

mfg

Penguin
Antworten PM Alle Chronologisch Zum Vorgänger
 
Melden nicht möglich
..  Update --> v. 0.95 :-)  (Penguin am 16.01.2005, 22:44:13)
 

Dieses Forum ist eine frei zugängliche Diskussionsplattform.
Der Betreiber übernimmt keine Verantwortung für den Inhalt der Beiträge und behält sich das Recht vor, Beiträge mit rechtswidrigem oder anstößigem Inhalt zu löschen.
Datenschutzerklärung