Kalender in mehreren UF nutzen

[michel34497]

Hallo Leute!

Hab da wieder eine Herausforderung für euch!

Ich habe viele Uf`s erstellt in denen es TextBoxen gibt, wo man ein Datum eintragen kann oder es mit DblClick automatisch einfügt.
Dies funtz nur teilweise.
Habe mir dazu einen Kalender von ### www.excel-werkstatt.de ### heruntergeladen.

Wichtig!
Diesen möchte ich auch gerne nutzen!

Meine frage an euch, wie bekome ich es hin das der Kalender bei DblClick das Datum in die TextBox, die gerade aktiv ist in der Aktuellen UF
die geöffnet ist einträgt?

Mein ansatz ist in dem KlassenModul:

Code:

'### www.excel-werkstatt.de ###

Option Explicit

Public WithEvents Label As MSForms.Label

Private Sub Label_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 
  If isFormLoaded("WartAus") Then
      WartAus.tbDatum.Value = CDate(Label.Tag)
   ElseIf isFormLoaded("Vorschau") Then
       If Vorschau.tbDatumvorschau1 Then
            Vorschau.tbDatumvorschau1.Value = CDate(Label.Tag)
        Else
            Vorschau.tbDatumvorschau2.Value = CDate(Label.Tag)
       End If
   ElseIf isFormLoaded("Warterst") Then
           If Warterst.TextBox28 Then
                   Warterst.TextBox28.Value = CDate(Label.Tag)
               Else
                   Warterst.TextBox32.Value = CDate(Label.Tag)
           End If
  End If
 
   Unload KalForm
End Sub

Ist dies möglich?
Und was mach ich FALSCH?

Rest Code:
Kalender Aufrufen aus einem Modul

Code:

'### www.excel-werkstatt.de ###

Option Explicit

Public cKal() As New clsKal
Public aktDat As Date

Function ErsterKW(KW As Integer, Jhr As Integer) As Double
Dim Erstertag As Double
If Month(aktDat) = 1 And KW > 51 Then Jhr = Jhr - 1
Erstertag = DateSerial(Jhr, 1, 1)
Do Until DatePart("WW", Erstertag, 2, 2) = 2
   Erstertag = Erstertag + 1
Loop
ErsterKW = DateAdd("WW", KW - 2, Erstertag)
End Function

Private Function KWoche(Datum As Date)
Dim t As Long
t = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
KWoche = ((Datum - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1
End Function

Sub Füllen()
Dim jCounter As Integer, KWZähler As Integer
Dim Tagzähler As Date

KalForm.Anzeige.Caption = Format(aktDat, "mmmm yyyy")
Tagzähler = ErsterKW(KWoche(DateSerial(Year(aktDat), Month(aktDat), 1)), Year(aktDat))
KWZähler = 1
For jCounter = 1 To 6
   KalForm.Controls("Label" & jCounter).Caption = KWoche(DateSerial(Year(aktDat), Month(aktDat), KWZähler))
   KWZähler = KWZähler + 7
Next jCounter
For jCounter = 7 To 48
   With KalForm.Controls("Label" & jCounter)
       .Tag = Tagzähler
       .Caption = Format(Tagzähler, "d")
       .ForeColor = IIf(Month(Tagzähler) <> Month(aktDat), &HC0C0C0, IIf(Weekday(Tagzähler, 2) > 5, &HFF&, &H0&))
       .BackColor = IIf(Tagzähler = Date, &HFFFF&, &HFFFFFF)
   End With
   Tagzähler = Tagzähler + 1
Next jCounter
End Sub

Ich weiß ihr braucht eine vorlage, aber vieleicht kann mir ja schon einer so Hilfestellung geben.



'

[michel34497]

Hallo!
So wie es aussieht kann mir keiner ohne vorlage helfen.
Darum stelle ich das komplette Projekt mal ein.
Wenn Excel geöffnet wird Startet die Uf Start.
Dann den Button Wartung erstellen auswählen.
Nun möchte ich wenn in der Textbox28 und TextBox32 ein DblClick gemacht wird, der Kalender sich öffnet (dies funzt auch).
Bei DblClick auf Kalender soll sichdas Datum in die Aktive TextBox eintragen.
Genauso soll es sein wenn eine andere Uf geöffnet ist.

Wie ich schon beschrieben habe denke ich das das problem im KlassenModul liegt

und zwar die abfrage nach der aktiven Textbox in der Aktiven UF.

Wenn ich "ActiveControl" einfüge gibt mir der Code immer eine Fehlermeldung aus.

WIE und WAS ist falsch am Code?

[Steffl]

Hallo Michael,

als Notlösung. Schreibe die ausgewählte TextBox in eine Zelle deiner Tabelle Data (in meinen Fall L1).

Code:

Private Sub Label_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 'Dim txt As MSForms
  If isFormLoaded("WartAus") Then
      WartAus.tbDatum.Value = CDate(Label.Tag)
  End If
   If isFormLoaded("Vorschau") Then
      Vorschau.tbDatumvorschau1.Value = CDate(Label.Tag)
   End If
   If isFormLoaded("Warterst") Then
      'If Warterst.MSForms = TextBox28 Then Warterst.TextBox28.Value = CDate(Label.Tag)
      'If Warterst.TextBox32 Then Warterst.TextBox32.Value = CDate(Label.Tag)

   End If
   MsgBox "Test"
If Worksheets("Data").Range("L1").Value = "TextBox32" Then
  'If ActiveControl Then
       Warterst.TextBox32.Value = CDate(Label.Tag)
  End If
   Unload KalForm
End Sub

Userform

Code:

Private Sub TextBox28_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   Worksheets("Data").Range("L1").Value = TextBox28.Name
   KalForm.Show
       If TextBox28 <> "" Then
          TextBox28.BackColor = &H80000005
       End If
End Sub

Code:

Private Sub TextBox32_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   
   Worksheets("Data").Range("L1").Value = TextBox32.Name
   KalForm.Show
End Sub

[schauan]

Hallöchen,

auf meiner Seite habe ich ein Beispiel der Übernahme eines Datums mit meinem "Ersatz-"Datepicker in eine TextBox. Du kannst ja mal reinschauen, vielleicht findest Du da einen Ansatz.
http://www.xltips.de/LNK-DOW-Power.html
Ich nehme an, dass Du die TextBox, von der aus Du Deinen Picker aufrufst, in eine Variable geben musst - oder ggf. deren Name - sodass Du dann vom Kalender oder wo auch immer ein günstiger Punkt ist, die TextBox füllen kannst.

[michel34497]

Hallo!

Danke für die hinweise.

Andre ich würde gerne deine Version nehmen.
Habe jedoch noch probleme:
1. Bei Start von DatePicker sind die Toggels schwarz und ich sehe nicht welche Zahlen drin stehen
2. würde ich gerne zur übernahme einen DblClick machen
3. Wie du schon auf deiner Seite beschrieben hast

Nachteil bei den Togglebuttons ist, das die Farbe im ungedrücktenZustand programmierbar ist, im gedrückten Zustand jedoch nicht.
Wer das braucht, müsste statt der Togglebuttons Commandbuttons nehmen.
Im ungedrückten Zustand könnte man z.B. den aktuellen Tag farblich hervorheben.

   würde ich gerne die CommandButtons nehmen und den aktuellen Tag farblich hervorheben ( )

Kannst du mir dabei weiter helfen?

[schauan]

Hallo Michael,

hat das bis nächstes Wochenende Zeit? Habe das Teil vor längerer Zeit programmiert und muss mir das mal anschauen (1.+2.) auch eine freie Minute finden oder zwei oder drei

[michel34497]

Hallo!

Klar doch!
Übe schon mal selbst weiter.

[schauan]

Hallöchen,

habe mal für 2007+ff eine erweiterte Version eingestellt, unter gleichem Link. Dort sind jetzt beide Varianten drin. Bei den Makros gibt es dann meist eine "C"-Variante für die Commandbuttons. Lediglich das Modul für die Variablen ist für beide. Das "Schwarz" habe ich bei mir nicht nachvollziehen können. Schaue mal, ob es bei den Commandbuttons auch so ist.

Wo sollte denn der Doppelklick hin? Auf die TextBox?

[michel34497]

Hallo!

Danke!

Wo sollte denn der Doppelklick hin? Auf die TextBox?

Nein!
Im moment ist es ja so, das wenn ich auf den DatePicker ein Datum auswähle das dies dann übernommen wird.
Mir würde es besser gefallen, das dies erst bei einem DblClick übernommen wird.

Das "Schwarz" habe ich bei mir nicht nachvollziehen können.

 Liegt wahrscheinlich an Windows XP.
Am anderen rechner mit Windows7 geht das.

Danke nochmals für deine Mühe!

[schauan]

Hallo Michael,

Doppelklick müsste ich mir mal ein paar Gedanken machen. Was soll denn dann bei einem einfachen Klick passieren und soll man nach einem einfachen Klick nochmal doppelklicken müssen, um das Datum zu übernehmen?

Ein Commandbutton reagiert ja auf einen Klick. Man könnte das eventuell so regeln, dass man die Schaltfläche nach dem ersten Klick gelb färbt und nichts übernimmt und nach dem zweiten Klick dann grün färbt und die Daten übernimmt. Klickt man beim zweiten mal auf eine andere Schaltfläche, wird diese gelb und die erste "entfärbt" Dauert dann aber auch wieder ein paar Tage, Wochenende ist ja so gut wie rum