Moderatori: Anthony47, Flash30005
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
ramset64 ha scritto:A questa soluzione ci avevo già pensato hihihih, quella del registro invece potrebbe valere un milione di dollari :-)
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
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
MsgBox CStr(DateSerial(2010, 9, 1))
Torna a Applicazioni Office Windows
"Spegnere" il riconoscimento data. Autore: aggittoriu |
Forum: Applicazioni Office Windows Risposte: 2 |
Ricavare dati di origine di un grafico online Autore: wallace&gromit |
Forum: Applicazioni Office Windows Risposte: 19 |
Come Ricavare una immagine dalla mia sottocartella e visuali Autore: Maury170419 |
Forum: Programmazione Risposte: 3 |
Visitano il forum: Nessuno e 129 ospiti