Questo browser non è più supportato.
Esegui l'aggiornamento a Microsoft Edge per sfruttare i vantaggi di funzionalità più recenti, aggiornamenti della sicurezza e supporto tecnico.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
ciao a tutti
vorrei velocizzare l'immissione di date in un foglio di excel e ho pensato a 2 soluzioni:
cosa mi suggerite?
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.
Ma stai seguendo la procedura qui sotto(in inglese)?
E, come ti è già stato consigliato, c'è anche questo:
o la semplice, banale UserForm proposta nel mio (lontano....) primo post:
Ciao gtsolid,
vorrei velocizzare l'immissione di date in un foglio di excel e ho pensato a 2 soluzioni:
- al posto di scrivere 09/07/2016 vorrei scrivere 09072016 e il programma dovrebbe in automatico riconoscere la data.
- quando una cella è selezionata, combinazione di tasti e che compaia un calendario da cui scegliere una data.
cosa mi suggerite?
Ti sconsiglio il primo approccio.
Prova ad inserire un controllo calendario, dai controlli ActiveX, sul foglio e nel modulo di codice del foglio. incolla il segente codice:
'=========>>
Option Explicit
'--------->>
Private Sub Calendar1_Click()
With ActiveCell
.Value = CDbl(Calendar1.Value)
.NumberFormat = "mm/dd/yyyy"
.Select
End With
End Sub
'--------->>
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range
Const mioIntervallo As String = "A1:A30" '<<=== Modifica
If Target.Cells.Count > 1 Then
Exit Sub
End If
Set Rng = Me.Range(mioIntervallo)
With Calendar1
If Not Application.Intersect(Rng, Target) Is Nothing Then
.Left = Target.Left + Target.Width - Calendar1.Width
.Top = Target.Top + Target.Height
.Visible = True
.Value = Date
ElseIf .Visible Then
.Visible = False
End If
End With
End Sub
'<<=========
Cliccando sulla cella (diciamo) A10, se vedrebbe qualcosa del genere:
Potresti scaricare il mio file di esempio Gtsolid20160709.xlsm a:
https://www.dropbox.com/s/69cio917kh4twrm/Gtsolid20160709.xlsm?dl=0
===
Regards,
Norman
Hai ragione (anche per la questione della incompatibilità del calendario con Office 64 bit che avevo trovato anche in altri articoli).
Magari se Mauro volesse dividere il topic dandogli un titolo differente così si ripulisce questo.
Ciao Casanmaner,
Per farla "completa" dovrei cercare che le dichiarazioni API in caso di utilizzo con Office a 64bit siano compatibili così come sono o se debbano essere dichiarate tramite PtrSafe (andando a impostare le dichirazioni tramite la condizione #If VBA7 ... #then ... #Else.
Non credo che il controllo calendario mscal.ocx che vorresti installare sia compatibile con Office a 64 bit.
Tuttavia, mi pare sia un punto opportuno di ritirarmi dalla discussione in quanto credo che la domanda di gtsolid fosse stata risolta con le prime due risposte di questo thread e che, nonostante ciò, siamo ormai raggiunti a ben 46 risposte.
A questo proposito ti ricordo la mia risposta di quattro giorni fa:
Ad ogni modo, vediamo cosa decide gtsolid e, per perseguire l'argomento, ti consiglierei eventualmente di aprire una nuova discussione.
Mentre io sono sempre ben disposto di discutere o dibattere, credo che ci sia il rischio di offuscare le soluzioni valide per altri che potessero cercare gli archivi della Community per risolvere dei problem particolari.
===
Regards,
Norman
La cosa sarebbe un po' OT ma, analizzando la funzione e utilizzando anche la funzione GetSystemDirectory, in pratica la cosa potrebbe essere gestita così per decidere se copiare i file nella cartella di sistema in base a Windows a 64bit o 32bit ed utilizzare il relativo regsvr32.exe per la registrazione del componente.
'----
Option Explicit
Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal lpBuffer As String, _
ByVal uSize As Integer) As Integer
Private Declare Function GetSystemWow64Directory Lib "Kernel32.dll" Alias _
"GetSystemWow64DirectoryA" (ByVal lpBuffer As String, _
ByVal uSize As Integer) As Integer
Sub Fix_MSCAL_OCX()
Dim Risp As Integer
Risp = MsgBox("Verrà lanciata la procedura per il Fix della mancata presenza del componente aggiuntivo MSCAL.OCX." & vbCrLf & _
"Assicurarsi che i file MSCAL.OCX e MSCAL.HLP, forniti assieme a questo file, siano salvati nella stessa directory" & _
"in cui è salvato questo file." & vbCrLf & "Continuare?", vbQuestion + vbOKCancel + vbDefaultButton1, "Fix MSCAL.OCX")
If Risp = vbCancel Then Exit Sub
Const sMsCalOcxName = "MSCAL.OCX"
Const sMsCalHelpName = "MSCAL.HLP"
Const sExeName = "regsvr32.exe"
Dim FSO As Object
Dim sOriginPathFile As String
Dim sDestinationPath As String
Dim FindDestinationPath As String * 255
Dim GSW64D As Integer, GSD As Integer
GSW64D = GetSystemWow64Directory(FindDestinationPath, Len(FindDestinationPath))
If GSW64D <> 0 Then
sDestinationPath = Left(FindDestinationPath, GSW64D)
Else
GSD = GetSystemDirectory(FindDestinationPath, Len(FindDestinationPath))
sDestinationPath = Left(FindDestinationPath, GSD)
End If
sDestinationPath = sDestinationPath & Application.PathSeparator
Set FSO = CreateObject("Scripting.FileSystemObject")
sOriginPathFile = ThisWorkbook.Path & Application.PathSeparator
With FSO
If .FolderExists(sDestinationPath) Then
If .FileExists(sOriginPathFile & sMsCalOcxName) And .FileExists(sOriginPathFile & sMsCalHelpName) Then
.CopyFile sOriginPathFile & sMsCalOcxName, sDestinationPath, True
.CopyFile sOriginPathFile & sMsCalHelpName, sDestinationPath, True
.DeleteFile sOriginPathFile & sMsCalOcxName
.DeleteFile sOriginPathFile & sMsCalHelpName
MsgBox "I files " & sMsCalOcxName & " e " & sMsCalHelpName & " sono stati copiati in " & sDestinationPath, vbInformation, "Fix MSCAL.OCX"
Call Shell("cmd.exe /C" & sDestinationPath & sExeName & " " & sMsCalOcxName, vbHide)
Else
MsgBox "I files " & sMsCalOcxName & " e " & sMsCalHelpName & " non sono presenti in " & sOriginPathFile & vbCrLf & _
"Copiare i files in " & sOriginPathFile & " e lanciare nuovamente il Fix!", vbCritical, "Fix MSCAL.OCX"
Exit Sub
End If
Else
MsgBox "La directory " & sDestinationPath & " non esiste!" & vbCrLf & _
"La procedura verrà interrotta.", vbCritical, "Fix MSCAL.OCX"
Exit Sub
End If
End With
Set FSO = Nothing
End Sub
'---
Per farla "completa" dovrei cercare che le dichiarazioni API in caso di utilizzo con Office a 64bit siano compatibili così come sono o se debbano essere dichiarate tramite PtrSafe (andando a impostare le dichirazioni tramite la condizione #If VBA7 ... #then ... #Else.