Option Compare Database
Option Explicit
Private rst As DAO.Recordset, HayVars As Boolean, MDb As DAO.Database


'***********************************************************************************
'* CambiaIdioma
'* cambia el idioma de las etiquetas, titulos o cuadros combinados en el objeto
'* formulario o informe indicado, el truco está en la propiedad tag (información
'* adicional de cada control, que contiene, cuando sea necesario y separados por
'* "|" la etiqueta y ToolTip en el caso de etiquetas o la tabla en el caso de
'* cuadros combinados
'* Argumentos: Objeto----> Formulario/Informe al que aplicar los cambios
'* uso: CambiaIdioma  Me
'* ESH 31/03/07 13:12
'* Modificado y adaptado para trabajar con Seek y servirse de una variable pública
'* (strIdioma)la cual le podemos dar el valor mediante un cuadro combinado.
'* Ximo Pascual 25/07/2012 17:21
' respeta la autoría y los creditos
'***********************************************************************************
Public Function CambiaIdioma(Objeto As Object)
    Dim ctrl As Object
    Dim intPosicion As Integer
    'Abrimos un recordset de la tabla Idiomas
    If Not HayVars Then CreaVars2

    If Not (rst.EOF And rst.BOF) Then
        'asignamos el nombre del formulario
        rst.Seek "=", Objeto.Tag
        If Not rst.NoMatch Then
        intPosicion = InStr(rst.Fields(strIdioma), "|")
        If intPosicion > 0 Then
            Objeto.Caption = Mid(rst.Fields(strIdioma), 1, intPosicion - 1)
        Else
            Objeto.Caption = rst.Fields(strIdioma)
        End If
        End If
        'recorremos los controles
        For Each ctrl In Objeto.Controls
            'le damos a Seek el número de ID almacenado en la propiedad Tag
            rst.Seek "=", ctrl.Tag
            ' busco la descripción correspondiente en el tag de cada control en el recordset
            ' y aplico (si los hubiera) la parte que está por delante del separador "|"
            ' al Caption y la que está por detrás al ToolTipText

            If Not rst.NoMatch Then
                Select Case ctrl.ControlType
                Case acLabel
                    intPosicion = InStr(rst.Fields(strIdioma), "|")
                    If intPosicion > 0 Then
                        ctrl.Caption = Mid(rst.Fields(strIdioma), 1, intPosicion - 1)
                    End If
                Case acCommandButton
                    intPosicion = InStr(rst.Fields(strIdioma), "|")
                    If intPosicion > 0 Then
                        ctrl.Caption = Mid(rst.Fields(strIdioma), 1, intPosicion - 1)
                        ctrl.ControlTipText = Mid(rst.Fields(strIdioma), intPosicion + 1)
                    End If
                Case acToggleButton
                    intPosicion = InStr(rst.Fields(strIdioma), "|")
                    If intPosicion > 0 Then
                        ctrl.Caption = Mid(rst.Fields(strIdioma), 1, intPosicion - 1)
                    End If
                Case acPage
                    intPosicion = InStr(rst.Fields(strIdioma), "|")
                    If intPosicion > 0 Then
                        ctrl.Caption = Mid(rst.Fields(strIdioma), 1, intPosicion - 1)
                    End If
                Case acComboBox
                    intPosicion = InStr(rst.Fields(strIdioma), "|")
                    If intPosicion > 0 Then
                        ctrl.ControlTipText = Mid(rst.Fields(strIdioma), intPosicion + 1)
                    End If
                Case acTextBox
                    intPosicion = InStr(rst.Fields(strIdioma), "|")
                    If intPosicion > 0 Then
                        ctrl.ControlTipText = Mid(rst.Fields(strIdioma), intPosicion + 1)
                    End If
                End Select
            End If
        Next ctrl
    End If
End Function
'sub que abre el recordset en modo lectura
'no hace falta cerrarlo ya que si no se hace no
'pasa nada.
Private Sub CreaVars2()
If HayVars Then Exit Sub
Set MDb = CurrentDb
Set rst = MDb.OpenRecordset("Idiomas", , dbReadOnly)
rst.Index = "id"
HayVars = True
End Sub
'*******************************************************************************
' DaMsg
' Nos muestra los mensajes predefinidos y guardados en una tabla (Idiomas)
' según el ID y el idioma de trabajo, la tabla deberá constar del ID
' y tantos campos como idiomas deseemos con un máximo de 254.
' A cada ID le corresponde un mensaje en varios idiomas
' Este mismo procedimiento nos sirve para cambiar el caption del formulario abierto
' Argumentos: num ------> número de ID buscado
' Uso Mensage: DaMsg (x)
'      MsgBox DaMsg(X)
' Ximo Pascual 25/07/2012 17:00
' respeta la autoría y los creditos
'*******************************************************************************
Public Function DaMsg(Item&) As String
    Dim intPosicion As Integer
    If Not HayVars Then CreaVars2
    rst.Seek "=", Item
    If Not rst.NoMatch Then
        intPosicion = InStr(rst.Fields(strIdioma), "|")
        If intPosicion > 0 Then
            DaMsg = Mid(rst.Fields(strIdioma), 1, intPosicion - 1)
        Else
            DaMsg = rst(strIdioma)
        End If
    End If
End Function
    
'Para cerrar el recordset si así lo deseamos
'aunque en verdad no hace falta
Public Sub BorraVars()
rst.Close
Set MDb = Nothing
HayVars = False
End Sub