DatePickerCalendario avvio su Case

Hai un problema con Excel?

Nuova discussione

DatePickerCalendario avvio su Case
di paganiva (utente non iscritto) data: 15/10/2014 16:18:43
Salve
Non riesco a adattare questa macro alle mie necessità.
In pratica vorrei che, in qualsiasi cella della riga C, attivi l'evento doppio click con il mouse, mi venga mostrato il calendario e la data scelta si posizioni sulla cella attiva.
Mi da errore dove indicato nel codice

'Codice nel foglio 

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'ActiveSheet.unProtect
'Dim DPF As Object
Dim cas As Range
Set DatePickerForm.Target = cas
Select Case Target.Column 
 Case 3 ' colonna C
    'Calendario
    DatePickerForm.Show vbModal
End Select
'impedisco la cancellazione  dei dati
Cancel = True
'ActiveSheet.Protect 
End Sub

‘Codice in form

Option Explicit

Private WithEvents Calendar1 As cCalendar
Public Target As Range
Private Sub Calendar1_Click()
    Call CloseDatePicker(True)
End Sub

Private Sub Calendar1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyEscape Then
        Call CloseDatePicker(False)
    End If
End Sub

Private Sub UserForm_Initialize()
    If Calendar1 Is Nothing Then
        Set Calendar1 = New cCalendar
        With Calendar1
            .Add_Calendar_into_Frame Me.Frame1
            .UseDefaultBackColors = False
            .DayLength = 3
            .MonthLength = mlENShort
            .Height = 120
            .Width = 180
            .GridFont.Size = 7
            .DayFont.Size = 7
            .Refresh
        End With
        Me.Height = 153 'Win7 Aero
        Me.Width = 197
    End If
End Sub
Private Sub UserForm_Activate()


'^^^^^^^^^^^^^^^^^^^^^^^ errore ^^^^^^  in If Isdate ....^^^^^^^
    If Isdate(Target.Value) Then
        Calendar1.Value = Target.Value  
    End If
    
    Call MoveToTarget   
End Sub

Public Sub MoveToTarget()
    Dim dLeft As Double, dTop As Double
    dLeft = Target.Left - ActiveWindow.VisibleRange.Left + ActiveWindow.Left
    If dLeft > Application.Width - Me.Width Then
        dLeft = Application.Width - Me.Width
    End If
    dLeft = dLeft + Application.Left   
    dTop = Target.Top - ActiveWindow.VisibleRange.Top + ActiveWindow.Top
    If dTop > Application.Height - Me.Height Then
        dTop = Application.Height - Me.Height
    End If
    dTop = dTop + Application.Top
    
    Me.Left = IIf(dLeft > 0, dLeft, 0)
    Me.Top = IIf(dTop > 0, dTop, 0)
End Sub

Sub CloseDatePicker(Save As Boolean)
    If Save And Not Target Is Nothing And Isdate(Calendar1.Value) Then
        Target.Value = Calendar1.Value
    End If
    Set Target = Nothing
    Me.Hide
End Sub

di Zer0Kelvin data: 15/10/2014 18:12:33
Ciao.
Intanto quando si riferisce un errore è meglio "favorire le generalità" dell'errore (codice e descrizione).
Intanto ci sono un paio "orrori":
1) in Worksheet_BeforeDoubleClick definisci una variabile e, senza impostarne il valore la assegni DatePickerForm.Target; il risultato è che DatePickerForm.Target vale Nothing (variabile oggetto non inizializzata)
in UserForm_Activate definisci una variabile range e le assegni il nome di una funzione VBA (IsDate), a quale scopo?
' (1) in Worksheet_BeforeDoubleClick correggi Dim cas As Range Set DatePickerForm.Target = cas ' in Set DatePickerForm.Target = Target ' (2) in UserForm_Activate elimina Dim Isdate As Range

di Zer0Kelvin data: 15/10/2014 18:22:41
PS: scusa, mi è "partita" la risposta prima che l'avessi completata.
Le due correzioni che ti ho suggerito dovrebbero essere sufficienti a risolvere il problema, ma l'assegnazione di DatePickerForm.Target andrebbe fatta all'interno del case e, se l'unica condizione è che la colonna sia la 3, non è necessario il Select...case, ma è sufficiente un'If...Then

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 3 Then
        Set DatePickerForm.Target = Target
        DatePickerForm.Show vbModal
    End If
    Cancel = True
End Sub

di paganiva (utente non iscritto) data: 15/10/2014 18:54:36
Ho messo il tuo codice e tutto ok.
Al momento mi basta il controllo da colonna C, ma tengo buona questa soluzione perchè potrebbe essere utile per altro.
Come ben sai nel file originale il codice era:

A colpo d'occho, come hai capito oltre non mi attento di andare, l'evento non dovrebbe scatenarsi solo con 2click in A1? o intende altro ?.
Perchè come vedo avviene sempre il Set non viene seguiti a fine istruzione da Nothing per chiudere l' istanza creata?.

Grazie e Saluti

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    '----------------------------------
    ' Open DatePicker
    Set DatePickerForm.Target = Target.Cells(1, 1)
    DatePickerForm.Show vbModal
    Cancel = True
    '----------------------------------
    
End Sub

di Zer0Kelvin data: 15/10/2014 22:24:10
Non sono sicurissimo di aver capito cosa vuoi dire, comunque se ho capito bene ti riferisci a

Target.Cells(1, 1)

che non indica la cella A1, ma la prima cella del range Target.
In questo contesto, specificare Cells(1,1) non ha nessun significato; avrebbe senso solamente se target fosse un intervallo composto da più celle ma, nell'evento BeforeDoubleClic, target è sempre composto da una singola cella, quindi Target e Target.Cells(1,1) sono la stessa cosa.
Per quanto riguarda il Set penso tu ti riferisca a

Set DatePickerForm.Target = Target

in questo caso, la variabile viene settata a nothing nella sub CloseDatePicker
di paganiva (utente non iscritto) data: 15/10/2014 22:55:28
Ok zerOkelvin hai centrato perfettamente le mie domande, con risposte chiare e precise.
Grazie

Vuoi Approfondire?