Excel Date- und Weekpicker

[volti]

Wer's brauchen kann...


Hallo,

ich musste meinen DatePicker mal wieder updaten.

Ich stelle ihn hier mal zur Verfügung, falls jemand so etwas brauchen kann.

Es handelt sich um eine Userform, aus der man Tage, Wochen oder Monate auswählen kann. Das Ziel kann eine Zelle oder eine Textbox sein.
Die Userform ist in ein AddIn eingebettet und kann vom Ribbon aus aktiviert werden.

   

In der Anlage ist aber auch ein Beispiel ohne AddIn....


  Excel_DatePicker_KHV.zip (Größe: 187,79 KB / Downloads: 38)

viele Grüße
Karl-Heinz

[volti]

Hallo Forumsteilnehmer,

aus aktuellem Anlass hier noch weitere Informationen zum Excel-DateWeek-Piicker:

Es wird oft danach gefragt, ob der DatePicker nicht auch mit individuellen Methoden aufgerufen werden kann.
Häufig möchte man z.B. per Doppelklick das Tool aufrufen und nicht aus der Menüleiste oder dem Contextmenü und das Ergebnis auch gleich in dieses Feld übernehmen.


Ja, auch das kann der "alte" DatePicker leisten.

Auf eine zunächst angedachte Klassenprogrammierung habe ich dann doch verzichtet, da der flexibelste Weg doch durch ein paar VBA-Zeilen in der eigenen Mappe ist.

Den DatePicker erreichst Du durch: Application.Run "DatePickerShowModeless" bzw. Application.Run "Excel_DatePicker.xlam!DatePickerShowModeless"

Schau Dir hierzu auch den u.a. VBA-Code dazu an und wie man den Bereich, der die Rückgaben aufnehmen soll, einschränken kann.
Dieser zeigt auch, wie man ggf. vorher Änderungen an den Einstellungen machen kann, wenn diese abweichend von den momentanen Einstellungen sein sollen. Z.B. die Position des Tools: -1 heißt hierbei, an der Klickstelle.
Will man den alten Zustand wiederherstellen, kann man vor der Aktion den alten Wert (s. Code) in einer Variablen ermitteln und später wieder einsetzen.


Ergänzend sei noch erwähnt, dass man das Icon bzw. den DatenPicker in der Menüleiste auch individuell je nach Mappe ein/ausblenden kann.
Einschalten z. B. durch  diesen Code in der Workbook_Open-Sub:
With Application.AddIns("Excel_Datepicker")
    If .Installed = False Then .Installed = True
End With

Code:

' Namen in der Registry
' "TB_Feld1", ""
' "TB_Feld2", ""
' "CB_Aktuell1", "Wahr"
' "CB_Aktuell2", "Wahr"
' "CB_ClpBrd", "Wahr"
' "CB_Feiertag", "Wahr"
' "CB_Sofort", "Wahr"
' "CB_Close", "Wahr"
' "TB_Posx", "-1"
' "TB_Posy", "-1"
' "CB_Monat", "Wahr"
' "CB_Sicherheit", "Wahr"
' "TB_Markierfarbe", ""

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim iSect, vPosX  As Variant
  Const sM1 As String = "Excel_DatePicker.xlam!SetVal"
  Const sM2 As String = "Excel_DatePicker.xlam!GetVal"
  
  Set iSect = Application.Intersect(Target, Range("E6:E10"))
  If Not iSect Is Nothing Then
     With Application
        vPosX = .Run(sM2, "TB_Posx", "")
        .Run sM1, "TB_Posx", -1
        .Run sM1, "TB_Posy", -1
        .Run "DatePickerShowModeless"
     End With
     Cancel = True
  End If
End Sub

_________
viele Grüße
Karl-Heinz