Controllo Calendario Excel 2003

Hai un problema con Excel?

Nuova discussione

Controllo Calendario (Excel 2003)
di TheProphet (utente non iscritto) data: 29/12/2012 00:37:50
Il componente funziona perfettamente, però lo trovo un po' macchinoso.
è possibile migliorarlo un po??
Nel senso che vorrei che ogni qualvolta che seleziono una casella formattata come data si attivi il componente in automatico senza dover premere il pulsante di 'Inserimento data wizard'.
E che quando seleziono la data desiderata non devo premere un pulsante per riportala nella cella, ma basta fare doppio click sul giorno desiderato.

MODULO:
Private Const CBR_INSERT As String = "Inserimento data wizard"

Private Const CTL_INSERT As String = "Inserisci data"
----------------------------------------------------------------
Sub Auto_Open()

   Dim cbrWiz       As CommandBar

   Dim ctlInsert    As CommandBarButton

   On Error Resume Next

   ' Inserisco la barra nella lista delle barre.

   Set cbrWiz = CommandBars(CBR_INSERT)


   If cbrWiz Is Nothing Then

      Err.Clear

      'istanzion la barra con il titolo

      Set cbrWiz = CommandBars.Add(CBR_INSERT)

      'la rendo visibile

      cbrWiz.Visible = True

      ' Aggiungo alla barra il pulsante il quale mi apre una form

      Set ctlInsert = cbrWiz.Controls.Add

      'imposto le varie proprietà del pulsante

      With ctlInsert

         .Style = msoButtonCaption

         .Caption = CTL_INSERT

         .Tag = CTL_INSERT

         'Indico che funzione intrapendere quando fa click sul bottone

         .OnAction = "ShowForm"

         'larghezza

         .Width = 200

      End With

Else

      ' se già c'è la barra la rendo visibile

      cbrWiz.Visible = True
      

   End If

End Sub
----------------------------------------------------------------------
Sub Auto_Close()

   On Error Resume Next

   ' cancello dalla lista delle barre la mia barra la scarico

   CommandBars(CBR_INSERT).Delete

End Sub
----------------------------------------------------------------
Sub ShowForm()


UserForm1.Show

End Sub
------------------------------------------------------------
------------------------------------------------------------
FORM:
Private Sub CommandButton1_Click()

ActiveCell.Value = Calendar1.Value

Unload Me

End Sub

di Vecchio Frac data: 29/12/2012 09:54:00
Per queste cose mi ricordavo che c'era il DataPicker.
Comunque appena ho un attimo provo a vedere meglio questo codice (e il tuo problema) se qualcun altro non fa prima di me :)

p.s. queste discussioni non sono un monopolio di pochi ma sono aperte a tutti e tutti son invitati a dire la loro su qualsiasi argomento.

di Vecchio Frac data: 29/12/2012 14:39:11
Con il codice sottostante risolvi il problema del "click and exit".
In pratica intercetti l'evento click del controllo Calendario, impostando la data su cui hai cliccato nella cella corrente ed uscendo dal form (ho aggiunto il fatto che la colonna si autoaggiusta in larghezza in base alla larghezza della data inserita).

Sull'avviare il form quando clicchi su una cella contenente una formattazione di data, guarda il secondo codice, in cui intercettiamo l'evento SelectionChange del foglio su cui deve operare la macro, controllando il formato di cella; se è diverso da "Generale" allora si visualizza il form. Attenzione però che se clicchi su una cella con numero si visualizza il form... devi aggiustare tu il codice, ora che hai capito il concetto ^_^

'codice in userform
Private Sub Calendar1_Click()
    ActiveCell = Calendar1.Value
    ActiveCell.Columns.AutoFit
    Unload Me
End Sub

'codice in foglio1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.NumberFormat <> "General" Then UserForm1.Show
End Sub

di TheProphet (utente non iscritto) data: 31/12/2012 13:04:41
Grazie mille dell'aiuto!! Funziona perfettamente!!
Però ora avrei un'altro problemino da risolvere: su excel 2013 64 non va perche non c'è nessun controllo calendario, e ho letto in internet che non esiste.

Cercando una soluzione, ho trovato un file in internet che funziona come un controllo e che non necessita di riferimenti.

Ho implementato il codice (con il tuo aiuto) cosicchè mi avvi il form quando seleziono una cella. Ho apportato solo una piccola modifica: If Target.NumberFormat <> "m/d/yyyy" cosi avvio il form solo con celle formattate come data.

L'unico problema che vorrei ancora risolvere è quello dell'altra volta.
Selezionando la data desiderata non devo premere un pulsante per riportala nella cella, ma basta fare doppio click sul giorno desiderato.

Penso che il codice usi delle matrici e se cosi fosse non so minimamente come funzionano

Foglio1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.NumberFormat = "m/d/yyyy" Then
    UserForm1.Show
End If
End Sub

----------------------------------------------------------------------------
UserForm1

Dim WithEvents CmdArray As cCtlMatrix


Private Sub UserForm_Initialize()
    Dim ctl As Control
    Set CmdArray = New cCtlMatrix
    For Each ctl In Me.Controls
        If TypeOf ctl Is MSForms.CommandButton Then
            CmdArray.Add ctl
        End If
    Next ctl
End Sub

Private Sub UserForm_Activate()
Dim ctl As Control
Me.dToDay = Format(Date, "mmmm yyyy")
Me.dToDay.TextAlign = fmTextAlignCenter
Me.DataSel = Date
Me.DataSel.TextAlign = fmTextAlignCenter
Call CreaCal
For Each ctl In Me.Controls
    If TypeOf ctl Is MSForms.CommandButton Then
        If ctl.Caption = CStr(Day(DataSel)) And ctl.Visible = True Then
            ctl.FontBold = True
            ctl.ForeColor = vbRed
            ctl.BackColor = RGB(255, 235, 205)
        End If
    End If
Next ctl
End Sub

Private Function CreaCal()
Dim ctl As Control
' carica il calendario
Dim curday As Variant, curbox As Integer
curday = DateSerial(Year(Me![dToDay]), Month(Me![dToDay]), 1)
curday = DateAdd("d", 1 - Weekday(curday, vbMonday), curday)
For curbox = 0 To 41
    Me("D" & curbox).Caption = Day(curday)
    Me("D" & curbox).Visible = False
    If Month(curday) = Month(Me!dToDay) Then Me("D" & curbox).Visible = True
    Me("D" & curbox).Font.Size = 7
    curday = curday + 1
Next curbox
End Function

Private Sub SpinButton1_SpinUp()
Dim ctl As Control
' sposta avanti i mesi
For Each ctl In Me.Controls
    If TypeOf ctl Is MSForms.CommandButton Then
        ctl.FontBold = False
        ctl.ForeColor = vbBlack
        ctl.BackColor = &H8000000F
    End If
Next ctl
Me.DataSel = ""
Me!dToDay = DateAdd("m", 1, dToDay)
Me.dToDay = Format(Me.dToDay, "mmmm yyyy")
Call CreaCal
End Sub

Private Sub SpinButton1_SpinDown()
' sposta in dietro i mesi
For Each ctl In Me.Controls
    If TypeOf ctl Is MSForms.CommandButton Then
        ctl.FontBold = False
        ctl.ForeColor = vbBlack
        ctl.BackColor = &H8000000F
    End If
Next ctl
Me.DataSel = ""
Me!dToDay = DateAdd("m", -1, dToDay)
Me.dToDay = Format(Me.dToDay, "mmmm yyyy")
Call CreaCal
End Sub

Private Sub CmdArray_Click(item As Object)
Dim selday As Integer, DateSelected As Variant, ctl As Control
For Each ctl In Me.Controls
If TypeOf ctl Is MSForms.CommandButton And ctl.Visible = True Then
    ctl.FontBold = False
    ctl.ForeColor = vbBlack
    ctl.BackColor = &H8000000F
End If
Next ctl
Me(item.Name).FontBold = True
Me(item.Name).ForeColor = vbRed
Me(item.Name).BackColor = RGB(255, 235, 205)
selday = Val(Me(item.Name).Caption)
Me.DataSel = DateSerial(Year(Me![dToDay]), Month(Me![dToDay]), selday)
End Sub

Private Sub CommandButton1_Click()
ActiveCell = Me.DataSel
UserForm1.Hide
End Sub

----------------------------------------------------------------------------------------
cCtlMatrix
Dim itm As cMatrixItem
Dim cControls As Collection

Public Event Click(item As Object)

Private Sub Class_Initialize()
    Set cControls = New Collection
End Sub

Public Sub Add(ByVal actItm As Object)
Set itm = New cMatrixItem
Set itm.CallerObject = Me
If TypeOf actItm Is MSForms.CommandButton Then
    Set itm.itmCmd = actItm
End If
cControls.Add itm
Set itm = Nothing
End Sub

Public Property Get Count() As Single
    Count = cControls.Count
End Property

Public Property Get ItemCollection(ByVal Index As Single) As Object
Dim tmpObject As Object
Set tmpObject = cControls(Index)
With tmpObject
    If Not .itmCmd Is Nothing Then Set ItemCollection = .itmCmd
End With
End Property

Friend Sub ItemClick(item As Object)
    RaiseEvent Click(item)
End Sub

------------------------------------------------------------------------------
cMatrixItem
Public WithEvents itmCmd As MSForms.CommandButton
Public CallerObject As cCtlMatrix

Private Sub itmCmd_Click()
CallerObject.ItemClick itmCmd
End Sub

di Vecchio Frac data: 31/12/2012 13:56:10
Il mio codice funzionava perchè il controllo Calendario (l'oggetto Calendario per essere precisi) espone l'evento Click, che si scatena quando si fa click su uno dei suoi pulsanti che rappresentano le date. Intercettando tale evento come hai visto è facile impostare la cella attiva al valore del pulsante/data premuto.
Come intuisci, hai appena scoperto un fac simile della matrice di controlli (difficile dirti in poche parole come funziona, il punto è che Excel non è VB e non possiede questa interessante proprietà, per cui bisogna simularla mediante un array di controlli).
Non avendo lo stesso tuo file (col relativo form che simula il controllo calendario) devo andare un po' a naso ma devi concentrarti su queste istruzioni:

'questo codice genera l'evento Click standard per l'oggetto su cui si è cliccato
Friend Sub ItemClick(item As Object)
RaiseEvent Click(item)
End Sub

'questo codice permette alla classe cCtlMatrix di gestire l'evento click del controllo associato alla collection
Private Sub itmCmd_Click()
CallerObject.ItemClick itmCmd
End Sub

Se non prendo una cantonata magistrale, è nell'evento Friend che devi impostare il codice che fa quello che vuoi tu; qualcosa del genere, per riallacciarsi al codice originale della soluzione proposta:

Friend Sub ItemClick(item As Object)
ActiveSheet.ActiveCell = item.Caption ' dovrebbe impostare la cella attiva al valore del pulsante premuto
ActiveSheet.ActiveCell.Columns.AutoFit
End Sub

Il concetto è questo. Dovrei avere in mano il file col controllo calendario simulato per essere più preciso ed eviatre errori (e quindi figuracce ^_^)
di TheProphet (utente non iscritto) data: 31/12/2012 15:18:36
Con l'inserimento delle due righe di codice mi da un errore: Proprietà o metodo non supportati dall'oggetto.
Non ti fai nessuna figuraccia, è difficile apportare modifiche senza avere il file sotto mano.

Comunque ho risolto anche se se l'oggetto ora ha qualche problemino che però non danno fastidio.
C'era una textbox che visualizzava la data nel form. ho semplicemente sostituito qualunque cosa riguardasse la textbox con ActiveCell.

Scusa se sono noioso, ma man mano che vado avanti trovo sempre modifiche da fare, quindi ti vorrei chiederti un'ultima cosa (almeno spero!!)
Se mi muovo con le frecce ogni volta che passo sulle celle formattate come data il form si avvia. E' possibile associare oltre che la selezione anche un tasto?? nel senso che se la cella è selezionata e premo il tasto D si avvia il form
Foglio1 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.NumberFormat = "m/d/yyyy" Then UserForm1.Show End If End Sub
di Vecchio Frac data: 01/01/2013 10:43:04
Non sei noioso ^_^
Item non espone Caption. Mi avvalgo della facoltà di non rispondere senza prove sottomano :)

Si apre il form perchè la cella viene attivata (SelectionChange), che sia con mouse o tastiera.
Puoi intercettare l'evento BeforeDoubleClick così si apre il form solo se fai doppio click sulla cella:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.NumberFormat = "m/d/yyyy" Then
UserForm1.Show
End If
End Sub

Per quello che pensavi di fare tu, crei una semplice macro generica e associala alla combinazione di tasti per esempio Ctrl-D.
di TheProphet (utente non iscritto) data: 01/01/2013 16:35:51
Ora è perfetto!! Grazie mille dell'aiuto!!

Vuoi Approfondire?