Microsoft Excel

Herbers Excel/VBA-Archiv

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

Anpassungen genialer Kalender

Betrifft: Anpassungen genialer Kalender von: Uwe
Geschrieben am: 27.03.2020 07:33:06

Hallo ihr lieben.


Ich habe hier diese Datei mit einem genialen Kalender gefunden.


https://www.herber.de/bbs/user/136144.xlsm


Jetzt habe ich 2 Fragen. Was muss angepasst werden, das bei einem Doppelklick auf ein Datum ( Auswahl des Datums im Kalender ) das Datum immer in das Feld "B10" geschrieben wird ?


Zusaetzlich sollte es so sein, das wenn das Datum "aus dem Kalender' heraus" kommt und in B10 geschrieben wird, das dann und nur dann wenn es aus dem Kalender kommt eine "Worksheet_SelectionChange" das sich auch auf B10 bezieht NICHT ausgefuehrt wird.


Vielen Dank, guten Start in den Tag and stay safe !

Betrifft: AW: Anpassungen genialer Kalender
von: Hajo_Zi
Geschrieben am: 27.03.2020 08:42:57

das selection wird nicht ausgeführt, da es ein Code von mir vist.
Option Explicit                                     ' Variablendefinition erforderlich
'**************************************************
'* H. Ziplies                                     *
'* 13.10.12                                       *
'* erstellt von HajoZiplies@WEB.de                *
'* http://Hajo-Excel.de
 *
'**************************************************
Public WithEvents Label As MSForms.Label

Private Sub Label_Click()
    If Month(Label.Tag) = Month(DaDatumKa) Then
        Range("B10") = DateValue(Label.Tag)               ' Tag in Zelle
        Range("B10").NumberFormat = "dd.mm.yy"           ' Zellformat Standard
        Unload Frm_Kalender                         ' UseerForm verlassen
    Else
        Erstellen Label.Tag                         ' ausgewählten Monat anzeigen
    End If
End Sub
GrußformelHomepage

Betrifft: AW: Anpassungen genialer Kalender
von: Uwe
Geschrieben am: 27.03.2020 09:08:55

Hallo Hajo,

vielen Dank ! Das war es schon. Klar. Ich hatte ja geschrieben das ich den Kalender hier gefunden hatte. Einfach Wahnsinn dieses Forum.

Passt alle auf euch auf und schoene Gruesse
Uwe

Betrifft: AW: Anpassungen genialer Kalender
von: Uwe
Geschrieben am: 27.03.2020 17:53:18

Hallo Hajo,

koenntest du mir bitte den Code auch noch so anpassen, das man in dem Kalender nur "Montage" auswaehlen kann und wenn kein Aufwand die Montage im Kalender des aktuellen Monats in gelber Schrift sind ?

Vielen Dank und schoenes Wochenende
Uwe

Betrifft: AW: Anpassungen genialer Kalender
von: Hajo_Zi
Geschrieben am: 27.03.2020 19:33:28

Hallo Uwe,

man reicht den kleinen Finger und es muss gleich der ganze Arm sein
Option Explicit                                     ' Variablendefinition erforderlich
Option Private Module                               ' damit Makros nicht unter dem Punkt Makro  _
erscheinen
'**************************************************
'* H. Ziplies                                     *
'* 27.03.2020                                     *
'* erstellt von HajoZiplies@WEB.de                *
'* http://Hajo-Excel.de
 *
'**************************************************
Public CoTag() As New cls_Tag                       ' Name für Klasseprogrammierung Tag
Public CoKW() As New cls_Kalenderwoche              ' Name für Klasseprogrammierung  _
Kalenderwoche
Public DaDatumKa As Date                            ' Datum Kalender Anfang
Public InI As Integer                               ' Schleifenvariable, Variable zum  _
zusamenfassen Tag
Public InK As Integer                               ' Schleifenvariable, Variable zum  _
zusamenfassen Kalenderwoche

Sub Start()
    Frm_Kalender.Show                               ' UserForm starten
End Sub

Sub Erstellen(DaDatum As Date)
    Dim InKwA As Integer                            ' Variable 1. Kalenderwoche im Monat
    Dim InKwE As Integer                            ' Variable letzte Kalenderwoche im Monat
    Dim LoI As Integer                              ' Schleifenvariable
    Dim Ob_Tag As MSForms.Label                     ' Variable für Objekt als neues Label Tag
    Dim Ob_KW As MSForms.Label                      ' Variable für Objekt als neues Label  _
Kalenderwoche
    Dim Ob_LaF As MSForms.Label                     ' Variable für Objekt als neues Label  _
Feiertage
    Dim LoZaehler As Long                           ' Zeile Label
    Dim LoZaehlerF As Long                          ' Zeile Feiertage
    Dim InJ As Integer                              ' Schleifenvariable Wochentage
    Dim DaAnfang As Date                            ' Anfangsdatum Kalender
    Dim StFeiertag As String                        ' Variable für Feiertag
    Dim BoFeier As Boolean                          ' Hinweis Bundesland
    Dim Ob_St As Object                             ' Variable Objekte
    DaDatumKa = DaDatum                             ' merken übergebenes Datum für  _
Klassenprogramm
    LoZaehler = 1                                   ' Überschriftenzeile schon da
    LoZaehlerF = 0                                  ' Überschriftenzeile schon da
    InI = 0                                         ' Variable für Zählen der Label auf 0 für  _
Array
    ' erster Tag in erster Woche
    DaAnfang = DateSerial(Year(DaDatum), Month(DaDatum), 1) - _
        Weekday(DateSerial(Year(DaDatum), Month(DaDatum), 1), 2) + 1
    ' Kalenderwoche für ersten Tag im Monat
    InKwA = KALENDERWOCHE_DIN(DateSerial(Year(DaDatum), Month(DaDatum), 1))
    ' Kalenderwoche für letzten Tag im Monat
    InKwE = KALENDERWOCHE_DIN(DateSerial(Year(DaDatum), Month(DaDatum) + 1, 1) - 1)
    With Frm_Kalender                               ' Bezug auf die UserForm
        .Cbo_Jahr.Tag = 1                           ' damit Erstellen bei Change nicht ausgelö _
st
        .Cbo_Monat.Tag = 1                          ' damit Erstellen bei Change nicht ausgelö _
st
        .Scb_Monat.Tag = 1                          ' damit Erstellen bei Change nicht ausgelö _
st
        ' ScrollBar auf aktuellen Wert setzen
        .Scb_Monat = (Year(DaDatum) - 1900) * 12 + Month(DaDatum)
        ' bei allen Label Beschriftung löschen und Farbe zurücksetzen
        .Cbo_Jahr = Year(DaDatum)                   ' ausgewähltes Jahr anzeigen in ComboBox
        .Lbl_Datum = Format(DaDatum, "MMMM YYYY")   ' ausgewählten Monat und Jahr anzeigen
        ' ausgewählten Monat anzeigen in ComboBox
        .Cbo_Monat = Format(DateSerial(Year(Date), Month(DaDatum), 1), "MMMM")
        For Each Ob_St In .Controls
            If TypeName(Ob_St) = "Label" Then
                With Ob_St
                    If Left(.Name, 5) = "Label" Then
                        .Caption = ""
                        .BackColor = -2147483633
                    End If
                End With
            End If
        Next Ob_St
        ' Schleife Label
        For LoI = 1 To 10                           ' keine ander Lösung gefunden für  _
Jahreswechsel
            ' Label Kalenderwoche erstellen im Rahmen
            Set Ob_KW = .Frm_Rahmen.Controls.Add("Forms.Label.1", "Label" & LoI, True)
            ' Eigenschaften dem erstellten Label zuweisen
            With Ob_KW
                .Left = 6                           ' Position links
                .Top = 15 * LoZaehler + 6           ' Position oben
                .Width = 25                         ' Breite
                .Height = 15                        ' Höhe
                .Font.Bold = True                   ' Schriftschnitt Fett
                ' Beschriftung mit der entsprechenden Kalenderwoche
                .Caption = KALENDERWOCHE_DIN(DaAnfang + (LoI - 1) * 7)
                .TextAlign = fmTextAlignRight
                .Tag = .Caption
            End With
            ReDim Preserve CoKW(0 To InK)
            Set CoKW(InK).Label = Ob_KW             ' Label zur Klasse zusammenfassen
            InK = InK + 1                           ' Zähler für das Array Label
            ' Kalenderwoche
            For InJ = 1 To 7
                ' Label Tag erstellen im Rahmen
                Set Ob_Tag = .Frm_Rahmen.Controls.Add("Forms.Label.1", "Label" & LoI & InI,  _
True)
                ' Eigenschaften dem erstellten Label zuweisen
                With Ob_Tag
                    .Left = 6 + InJ * 30            ' Position links
                    .Top = 15 * LoZaehler + 6       ' Position oben
                    .Width = 25                     ' Breite
                    .Height = 15                    ' Höhe
                    .Tag = DaAnfang + InI           ' Datum
                    .Caption = Day(DaAnfang + InI)  ' Tag
                    .Tag = DaAnfang + InI
                    .TextAlign = fmTextAlignRight   ' Ausrichtung  rechts
                    ' Farbe Wochenende
                    If DaAnfang + InI = Date Then
                        .BackColor = 65535
                    End If
                    If Weekday(DaAnfang + InI, 2) > 5 Then
                        .ForeColor = 255
                    End If
                    ' Farbe für Tage außerhalb des aktuellen Monats
                    If Month(DaAnfang + InI) <> Month(DaDatum) Then
                        .ForeColor = 8421504
                    End If
                    If .ForeColor <> 8421504 Then
                        If Weekday(DaAnfang + InI, 2) = 1 Then
                            .BackColor = 65535
                        End If
                    End If
                   ' Feiertag
                    ' Feiertag nur im aktuellen Monat
                    'If Month(DaAnfang) = Month(DaDatum + InI) Then
                        StFeiertag = Feiertag(DaAnfang + InI)
                    'End If
                    If StFeiertag <> "" Then
                        .BackColor = 13434828       ' Hintergrundfarbe ändern
                    End If
                    ' Label zusammenfassen
                    ' Neudimensionierung des Array
                    ReDim Preserve CoTag(0 To InI)
                    Set CoTag(InI).Label = Ob_Tag  ' Label zur Klasse zusammenfassen
                    InI = InI + 1                   ' Zähler für das Array Label
                End With
                ' Feiertage auflisten im 2. Rahmen
                If StFeiertag <> "" And Month(DaAnfang + InI) = Month(DaDatum) Then
                    Set Ob_LaF = .Frm_Rahmen2.Controls.Add("Forms.Label.1", "LabelF" &  _
LoZaehlerF, True)
                    ' Eigenschaften dem erstellten Label zuweisen
                    With Ob_LaF                     ' Bezug auf das erstelle Label
                        .Left = 6                   ' Position links
                        .Top = 15 * LoZaehlerF + 6  ' Position oben
                        .Width = 238                ' Breite
                        .Height = 15                ' Höhe
                        ' Beschriftung mit Feiertag
                        .Caption = " " & DaAnfang + InI - 1 & " " & StFeiertag
                        .TextAlign = fmTextAlignLeft
                        .BackColor = 13434828       ' Hintergrundfarbe Grün
                        ' prüfen ob Bundesland abhängiger Feiertag
                        If InStr(StFeiertag, "*") > 0 Then BoFeier = True
                    End With
                    LoZaehlerF = LoZaehlerF + 1     ' Zeilenzähler Feiertage erhöhen
                End If
            Next InJ
            LoZaehler = LoZaehler + 1               ' Zeilenzähler Kalenderwoche erhöhen
            ' Schleife verlassen, wenn Montag im nächsten Monat
            If Month(DaAnfang + LoI * 7) <> Month(DaDatum) Then Exit For
        Next LoI
        If BoFeier Then                             ' es gibt Feiertage Bundesland abhängig
            Set Ob_LaF = .Frm_Rahmen2.Controls.Add("Forms.Label.1", "LabelF" & LoZaehlerF + 1,  _
True)
            ' Eigenschaften dem erstellten Label zuweisen
            With Ob_LaF                             ' Bezug auf das erstellte Label
                .Left = 6                           ' Position links
                .Top = 15 * LoZaehlerF + 6          ' Position oben
                .Width = 238                        ' Breite
                .Height = 15                        ' Höhe
                ' Hinweis Feiertag
                .Caption = " * Feiertag Bundesland abhängig"
                .TextAlign = fmTextAlignLeft        ' Ausrichtung
                .BackColor = 13434828               ' Hintergrundfarbe Grün
            End With
            LoZaehlerF = LoZaehlerF + 1
        End If
        ' Rahmenhöhe Rahmen2
        .Frm_Rahmen.Height = 15 * LoZaehler + 16
        If LoZaehlerF = 0 Then
            .Frm_Rahmen2.Height = 0                 ' Rahmenhöhe 0, da kein Eintrag
        Else
            ' Rahmenhöhe und Position Rahmen2
            .Frm_Rahmen2.Height = 15 * LoZaehlerF + 16
            .Frm_Rahmen2.Top = .Frm_Rahmen.Height + 65
        End If
        ' UserFormhöhe
        .Height = .Frm_Rahmen.Height + .Frm_Rahmen2.Height + 95
        .Cbo_Jahr.Tag = ""                          ' zurücksetzen damit Erstellen bei Change  _
ausgelöst wird
        .Cbo_Monat.Tag = ""                         ' zurücksetzen damit Erstellen bei Change  _
ausgelöst wird
        .Scb_Monat.Tag = ""                         ' zurücksetzen damit Erstellen bei Change  _
ausgelöst wird
    End With
    Set Ob_Tag = Nothing                            ' Variablen leeren
    Set Ob_LaF = Nothing                            ' Variablen leeren
End Sub


Option Explicit                                     ' Variablendefinition erforderlich
'**************************************************
'* H. Ziplies                                     *
'* 27.03.2020                                     *
'* erstellt von HajoZiplies@WEB.de                *
'* http://Hajo-Excel.de
 *
'**************************************************
Public WithEvents Label As MSForms.Label

Private Sub Label_Click()
    If Label.ForeColor <> 8421504 Then
        If Month(Label.Tag) = Month(DaDatumKa) Then
            If Weekday(CDate(Label.Tag), 2) = 1 Then
                Range("B10") = DateValue(Label.Tag)               ' Tag in Zelle
                Range("B10").NumberFormat = "dd.mm.yy"           ' Zellformat Standard
                Unload Frm_Kalender                         ' UseerForm verlassen
            Else
                MsgBox "Flasches Datum"
            End If
        Else
            Erstellen Label.Tag                         ' ausgewählten Monat anzeigen
        End If
    End If
End Sub
Gruß Hajo

Betrifft: AW: Anpassungen genialer Kalender
von: Uwe
Geschrieben am: 29.03.2020 07:46:24

Hallo Hajo,

vielen vielen Dank und einen schoenen Sonntag !

Stay all safe and healthy !

Beiträge aus dem Excel-Forum zum Thema "Anpassungen genialer Kalender"