Condividi:        

[vba] domanda da un milione di dollari: ricavare f.to data

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

[vba] domanda da un milione di dollari: ricavare f.to data

Postdi ramset64 » 20/09/10 08:27

Più per curiosità che per necessità, mi piacerebbe sapere se esiste una istruzione vba per riconoscere il formato internazionale su cui è settato il pc.... domandona... :-) grazie
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Sponsor
 

Re: [vba] domanda da un milione di dollari

Postdi Flash30005 » 20/09/10 10:02

Un sistema "semplice" potrebbe essere quello di analizzare la stringa data ( Now() )
con una macro come questa

Codice: Seleziona tutto
Sub ControlloData()
Dim OraC As String
OraC = Now()
If Mid(OraC, 14, 1) <> ":" Then MsgBox " ATTENZIONE! Il formato dell'ORA impostato nel PC non è Europeo (HH:mm:ss)"
If Mid(OraC, 5, 1) = "-" Then MsgBox " ATTENZIONE! Il formato della Data impostato nel PC non è Europeo (gg/MM/aaaa)"
MsgBox OraC
End Sub


Volendo si potrebbe, sempre tramite macro, verificare questa configurazione direttamente nel registro di windows
ma mi occorre un un po' più di tempo.

Se tutto Ok fai sapere
dove devo andare per ritirare il milione di dollari :lol:

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [vba] domanda da un milione di dollari

Postdi ramset64 » 20/09/10 10:41

A questa soluzione ci avevo già pensato hihihih, quella del registro invece potrebbe valere un milione di dollari :-)
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [vba] domanda da un milione di dollari

Postdi Flash30005 » 20/09/10 10:48

ramset64 ha scritto:A questa soluzione ci avevo già pensato hihihih, quella del registro invece potrebbe valere un milione di dollari :-)


Prepara l'assegno! 8)

1) Apri una cartella vuota
2) vai nel VBA
3) crea due nuovi moduli (Modulo1 e Modulo2)
4) nel modulo1 inserisci questo codice:

Codice: Seleziona tutto
Private Function FormatoDataPC() As String
    Dim esito As Long
    Dim valore As Variant
    esito = Modulo2.QueryKeyValue( _
            Modulo2.HKEY_CURRENT_USER, "Control Panel\International\", "sShortDate", valore)
    Dim versione As String
    FData = CStr(valore)
    If Mid(FData, 1, 3) = "dd/" Then
        MsgBox "Data in formato Europeo"
    Else
        MsgBox "Data non in formato Europeo"
    End If
End Function

5) nel Modulo2 inserisci questo codice:

Codice: Seleziona tutto
Option Explicit

Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003

Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259

Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_ALL_ACCESS = &H3F

Private Const REG_OPTION_NON_VOLATILE = 0

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal hKey As Long _
        ) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal Reserved As Long, _
        ByVal lpClass As String, _
        ByVal dwOptions As Long, _
        ByVal samDesired As Long, _
        ByVal lpSecurityAttributes As Long, _
        phkResult As Long, _
        lpdwDisposition As Long _
        ) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long _
        ) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        ByVal lpData As String, _
        lpcbData As Long _
        ) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        lpData As Long, _
        lpcbData As Long _
        ) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        ByVal lpData As Long, _
        lpcbData As Long _
        ) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal Reserved As Long, _
        ByVal dwType As Long, _
        ByVal lpValue As String, _
        ByVal cbData As Long _
        ) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal Reserved As Long, _
        ByVal dwType As Long, _
        lpValue As Long, _
        ByVal cbData As Long _
        ) As Long



Public Function QueryKeyValue( _
        lPredefinedKey As Long, _
        sKeyName As String, _
        sValueName As String, _
        vValue As Variant _
        ) As Long
    Dim lRetVal As Long
    Dim hKey As Long

    lRetVal = RegOpenKeyEx( _
            lPredefinedKey, _
            sKeyName, _
            0, _
            KEY_QUERY_VALUE, _
            hKey _
            )
    If lRetVal <> ERROR_NONE Then
        QueryKeyValue = lRetVal
        Exit Function
    End If
   
    lRetVal = QueryValueEx( _
            hKey, _
            sValueName, _
            vValue _
            )
    If lRetVal <> ERROR_NONE Then
        QueryKeyValue = lRetVal
    End If

    RegCloseKey (hKey)
End Function

Private Function QueryValueEx( _
        ByVal lhKey As Long, _
        ByVal szValueName As String, _
        vValue As Variant _
        ) As Long
    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError

    lrc = RegQueryValueExNULL( _
            lhKey, _
            szValueName, _
            0&, _
            lType, _
            0&, _
            cch _
            )
    If lrc <> ERROR_NONE Then Error 5

    Select Case lType
        ' For strings
        Case REG_SZ:
            sValue = String(cch, 0)

            lrc = RegQueryValueExString( _
                    lhKey, _
                    szValueName, _
                    0&, _
                    lType, _
                    sValue, _
                    cch _
                    )
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch - 1)
            Else
                vValue = Empty
            End If
        ' For DWORDS
        Case REG_DWORD:
            lrc = RegQueryValueExLong( _
                    lhKey, _
                    szValueName, _
                    0&, _
                    lType, _
                    lValue, _
                    cch _
                    )
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            lrc = -1
    End Select

QueryValueExExit:
    QueryValueEx = lrc
    Exit Function

QueryValueExError:
    Resume QueryValueExExit
End Function


Avvia la funzione del Modulo1

Se preferisci il Bonifico ti invio le mie coordinate bancarie :lol: :lol: :lol:

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi ramset64 » 20/09/10 11:40

Non ho al momento la possibiltà di provare ma non ho dubbi che funzionerà alla grande... per il pagamento possiamo rateizzare in 2.000.000.000 di comode rate annuali? Scherzi a parte... grazie, sei un grande ciao :-)
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi Anthony47 » 20/09/10 18:09

Scusate, un premio per fare le cose in un modo complesso? Da sola questa istruzione chiaramente visualizza il formato in uso:
Codice: Seleziona tutto
MsgBox CStr(DateSerial(2010, 9, 1))

Ad esempio nelle varie prove mi ha restituito:
1/9/10 (formato g/m/aa)
01/09/10 (gg/mm/aa)
1-9-10 (gg-m-aa)
2010-09-01 (aaaa-mm-gg)
etc...

Elaborando la stringa si possono estrarre le informazioni che servono, es quale e' la posizione dell' anno nel testo delle date.
E' ovvio che se avessimo usato DateSerial(2010, 10, 10) non avremmo cavato un ragno dal buco, e anche con mesi/giorni su due digit alcune combinazioni di formato sarebbero state impossibili da decodificare.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi ricky53 » 20/09/10 18:23

Ciao,
e con
MsgBox Now()
non sarebbe stato male il risultato ?

Certo il primo gennaio alle ore 01:01 ... ma in linea di massima.

Che ne dite?

Ciao da Ricky53
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi Anthony47 » 20/09/10 18:29

Non sarebbe stata la stessa cosa, perche' dipende dal giorno in cui la esegui: il 10/10/2010 non caveresti grandi informazioni; ma anche il 20/9/2010 non riusciresti a scoprire se e' settato g/m/aaaa o gg/m/aaaa.
Se invece imponi tu una data sai che cosa devi ritrovarti, anche se non sai in che posizione...

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi Flash30005 » 20/09/10 23:57

I sistemi per conoscere il formato data di un SO ne abbiamo illustrati diversi dai più semplici a quelli più complessi e ce ne sono sicuramente tanti altri.
Penso, forse erroneamente, che il quesito di Ramset64 si riferiva sì, al conoscere il formato data ma anche che quel quesito non era esposto interamente per risolvere il suo problema reale, ripeto, posso sbagliarmi.

Secondo me Ramset64 ha un applicativo o programma o macro che funziona solo se la data è Europea (suppongo più una macro "autocostruita") e allora vorrebbe testare la data prima che si avvii l'applicazione per fornire un messaggio di avviso di cambiare la data nello standard dell'applicativo.

Il quesito reale dovrebbe essere: "come posso cambiare il formato data se è diversa da quella prevista?"

Allora non serve nessun rilevamento complesso (è sufficiente analizzare ll terzo carattere di una data)
occorre, invece, un codice che se il formato data è diversa da quello previsto cambi il formato al SO, dunque nel registro.
Dico questo perché mi sono trovato nelle stesse condizoni anni fa e risolsi egregiamente proprio con del codice VBA.
Ma evito di mettere dei codici che modifichino il registro in un forum aperto al pubblico.

Aspetto vostre impressioni e quelle di Ramset64
ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi ramset64 » 21/09/10 11:27

La mia impressione è che voi ne sapete una più del diavolo (complimenti sinceri)... in realtà il mio quesito era solo una curiosità (e mi pare di averlo scritto nel primo post)... detto questo la curisiotà mi è stata tolta perchè grazie a voi ho capito che in caso di necessità di soluzioni ve ne sono parecchie.... grazie ed un saluto a tutti.
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi Black.Jack » 21/09/10 13:13

Ma...invece c'è la maniera di far saltare fuori il giorno esatto?

sicuramente legando ad una tabella a parte il valore del giorno da uno a sette e poi in qualche modo legarlo all'anno solare corrente....

ma c'è la maniera di estrarlo dal sistema? nel calendario di windows legato al formato orario ci sono...
Win7 + Office 2010 Ita
Xp + Office 2010 Ita
Black.Jack
Utente Junior
 
Post: 93
Iscritto il: 23/06/10 08:40

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi Anthony47 » 21/09/10 14:41

Io non ho afferrato il quesito...
Se non ricevi risposte prova quindi a spiegare diversamente, a cominciare da che cosa intendi per "giorno esatto".

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi Black.Jack » 21/09/10 16:33

si certo!


intendevo...io indico il giorno 21 settembre...ed è automatica l'assegnazione del giorno della settimana ossia martedì :D
Win7 + Office 2010 Ita
Xp + Office 2010 Ita
Black.Jack
Utente Junior
 
Post: 93
Iscritto il: 23/06/10 08:40

Re: [vba] domanda da un milione di dollari: ricavare f.to da

Postdi ricky53 » 21/09/10 23:40

Ciao,
praticamente tu vorresti, dopo aver scritto una data sapere il girono della settiamana di quella data?

Prova con il formato cella impostato a

gg/mm/aaaa gggg


se invece vuoi il giorno in un'altra cella prova con
=GIORNO.SETTIMANA(A1; 2) ed ottieni "2" che è martedì

se vuoi proprio la parola "martedì' devi utilizzare una cella di appoggio il cui formato è "gggg" e la formula nella cella è =A1, dove in A1 c'è la data digitata.

Ciao da Ricky53
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia


Torna a Applicazioni Office Windows


Topic correlati a "[vba] domanda da un milione di dollari: ricavare f.to data":


Chi c’è in linea

Visitano il forum: Nessuno e 44 ospiti