Resumen Cambiar la configuración regional

Te mando este archivo, a ver si te vale.
No te comento los procedimientos ni las funciones porque ahora mismo no tengo tiempo, y como supongo que te corre prisa ...

Para cualquier aclaración escribeme a:

josejrp@iname.com

Bye !!


'****************************************************
'* Inicio - para cambiar la Configuración Regional
'****************************************************
Public Const LOCALE_USER_DEFAULT = &H400
Public Const LOCALE_SYSTEM_DEFAULT = &H800
Public Const LOCALE_ICURRDIGITS = &H19
Public Const LOCALE_SSHORTDATE = &H1F
Public Const LOCALE_SCURRENCY = &H14

Public Const LOCALE_SDATE = &H1D
Public Const LOCALE_SDECIMAL = &HE
Public Const LOCALE_STHOUSAND = &HF

Declare Function GetLocaleInfo Lib "Kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Declare Function SetLocaleInfo Lib "Kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Long

Public Function ActualConfgRegional(lngTipo As Long) As String
    Dim lngBufferLen As Long
    Dim intRetorno As Integer
    Dim strBuffer As String
    On Error GoTo ActualConfgRegional_err

    lngBufferLen = 50
    strBuffer = Space$(lngBufferLen)

    intRetorno = GetLocaleInfo(LOCALE_USER_DEFAULT, lngTipo, strBuffer, lngBufferLen)
    'intRetorno = GetLocaleInfo(LOCALE_SYSTEM_DEFAULT, lngTipo, strBuffer, lngBufferLen)
    ActualConfgRegional = Left$(strBuffer, InStr(strBuffer, Chr(0)) - 1)

    Exit Function
ActualConfgRegional_err:
    MensajeError "ActualConfgRegional", " Editando valor " & CStr(lngTipo)
End Function

Public Sub PonerConfgRegional(lngTipo As Long, strNuevoValor As String)
    Dim intRetorno As Integer
    On Error GoTo PonerConfgRegional_err

    intRetorno = SetLocaleInfo(LOCALE_USER_DEFAULT, lngTipo, strNuevoValor)

    Exit Sub
PonerConfgRegional_err:
    MensajeError "PonerConfgRegional", " Estableciendo valor " & CStr(lngTipo)
End Sub

Public Function ConfgRegionalCorrecta() As Boolean
    On Error GoTo ConfgRegionalCorrecta_err

    ConfgRegionalCorrecta = True

    If (ActualConfgRegional(LOCALE_ICURRDIGITS) <> "3") Then
        ConfgRegionalCorrecta = False
    Else
        If (ActualConfgRegional(LOCALE_SSHORTDATE) <> "dd/MM/yyyy") Then
            ConfgRegionalCorrecta = False
        Else
            If (ActualConfgRegional(LOCALE_SCURRENCY) <> "pts") Then
                ConfgRegionalCorrecta = False
            Else
                If (ActualConfgRegional(LOCALE_SDATE) <> "/") Then
                    ConfgRegionalCorrecta = False
                Else
                    If (ActualConfgRegional(LOCALE_SDECIMAL) <> ",") Then
                        ConfgRegionalCorrecta = False
                    Else
                        If (ActualConfgRegional(LOCALE_STHOUSAND) <> ".") Then
                            ConfgRegionalCorrecta = False
                        End If
                    End If
                End If
            End If
        End If
    End If

    Exit Function
ConfgRegionalCorrecta_err:
    MensajeError "ConfgRegionalCorrecta"
End Function

Public Sub AjustarConfgReg()
    On Error GoTo AjustarConfgReg_err

    PonerConfgRegional LOCALE_ICURRDIGITS, "3"
    PonerConfgRegional LOCALE_SSHORTDATE, "dd/MM/yyyy"
    PonerConfgRegional LOCALE_SCURRENCY, "pts"
    PonerConfgRegional LOCALE_SDATE, "/"
    PonerConfgRegional LOCALE_SDECIMAL, ","
    PonerConfgRegional LOCALE_STHOUSAND, "."

    Exit Sub
AjustarConfgReg_err:
    MensajeError "AjustarConfgReg"
End Sub

'****************************************************
'* Fin - para cambiar la Configuración Regional
'****************************************************



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com