Configurar Idioma dos Fornulários de acordo com o Idioma selecionado na configuração

Em ajuda a um colega do Fórum:

Para chamar a função no Formulário:

Private Sub Form_Load()
Call fncAplicaIdioma(Me)
End Sub

O
nome do form será levada a função pela variável Formulario, e sera
utilizada para filtrar na aplicação dos nomes dos rótulos e o caption do
formulário


MÓDULO:

Option Compare Database
Option Explicit

Dim RsIdioma        As DAO.Recordset
Dim StrSQL          As String
Public varIdioma    As Variant
Public k            As Long
Public IntIdioma    As Integer



Function CarregaIdioma()
    '-----------------------------------------------------------------------------
    'O recordset é passado para variável varPer que irá preservar o recordset até
    'que o aplicativo seja fechado ou um novo login seja realizado.
    '-----------------------------------------------------------------------------
    StrSQL = "SELECT tblForms.ID_Form, tblForms.NomeForm, tblForms.Portugues AS tblForms_Portugues," _
           
 & "tblForms.Ingles AS tblForms_Ingles, tblForms.Espanhol AS 
tblForms_Espanhol, tblForms.Alemao AS tblForms_Alemao," _
            & "tblForms.Frances AS tblForms_Frances, tblIdiomasRT.ID_Idioma, tblIdiomasRT.FormID, tblIdiomasRT.Controle," _
            & "tblIdiomasRT.Portugues AS tblIdiomasRT_Portugues, tblIdiomasRT.Ingles AS tblIdiomasRT_Ingles," _
            & "tblIdiomasRT.Espanhol AS tblIdiomasRT_Espanhol, tblIdiomasRT.Alemao AS tblIdiomasRT_Alemao," _
           
 & "tblIdiomasRT.Frances AS tblIdiomasRT_Frances FROM tblForms INNER
 JOIN tblIdiomasRT ON tblForms.[ID_Form] = tblIdiomasRT.[FormID];"

    Set RsIdioma = CurrentDb.OpenRecordset(StrSQL, 4)
    RsIdioma.MoveLast: RsIdioma.MoveFirst
    
    k = RsIdioma.RecordCount
    varIdioma = RsIdioma.GetRows(k) 'passa o recordset para a variável varPer

    RsIdioma.Close
    Set RsIdioma = Nothing
End Function

Function ConfIdioma()
'carego a valor referente ao Idioma selecionado no grupo de opções
IntIdioma = DLookup("Idioma", "tblConf")
End Function

'---------------------------------------------------------------------------------------
' Procedure     : Form_Load
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 10/03/2013
' Comentários   : Renomeia o Caption do Rótulo de acordo com o idioma selecionado
'                 Confeccionado para Luis Araujo
'---------------------------------------------------------------------------------------

Function fncAplicaIdioma(Formulario As Form)
Dim Ctl         As Control
Dim j           As Long
'-----------------------------------------------------------------------------------------------
'Usamos os valores da tabela tblIdiomasRT que estão presevados na variável varIdioma
'Essa técnica evita que façamos viagens desnecessárias a tabela para se obter os valores
'direto da tabela.
'-----------------------------------------------------------------------------------------------

'Faço um loop pelos controles do form
For Each Ctl In Formulario.Controls
    'Crio um case para verificar o tipo de controle
    Select Case Ctl.ControlType
        'Caso seja um rótulo
        Case acLabel 'acTextBox ', acComboBox, acListBox, acOptionGroup, acCheckBox
            'Para o Idoma Português
            If IntIdioma = "0" Then
                'Percorre a Matriz verificando se o nome do controle é igual ao valo contido na coluna 2 da Variável VarIdioma
                'de acordo com a quantidade de registros contidos na mesma
                For j = 0 To UBound(varIdioma)
                    'Se o nome do controle  e o nome do formulário equivale ao registro na variável,  aplica o memso no Rótulo
                    'e o nome do Formulário segundo o idoma selecionado
                    If Ctl.Name = CStr(varIdioma(9, j)) And Formulario.Name = CStr(varIdioma(1, j)) Then
                        Ctl.Caption = CStr(varIdioma(10, j))
                    End If
                Next
            'Aplica o Nome fo Formulário contido na tblForms segundo o idioma ao Caption do mesmo
            Formulario.Caption = CStr(varIdioma(2, j))
            'Para o Idoma Ingles
            ElseIf IntIdioma = "1" Then
                'Percorre a Matriz verificando se o nome do controle é igual ao valo contido na coluna 2 da Variável VarIdioma
                'de acordo com a quantidade de registros contidos na mesma
                For j = 0 To UBound(varIdioma)
                    'Se o nome do controle  e o nome do formulário equivale ao registro na variável,  aplica o memso no Rótulo
                    'e o nome do Formulário segundo o idoma selecionado
                    If Ctl.Name = CStr(varIdioma(9, j)) And Formulario.Name = CStr(varIdioma(1, j)) Then
                        Ctl.Caption = CStr(varIdioma(11, j))
                    End If
                Next
            'Aplica o Nome fo Formulário contido na tblForms segundo o idioma ao Caption do mesmo
            Formulario.Caption = CStr(varIdioma(3, j))
            'Para o Idoma Espanhol
            ElseIf IntIdioma = "2" Then
                'Percorre a Matriz verificando se o nome do controle é igual ao valo contido na coluna 2 da Variável VarIdioma
                'de acordo com a quantidade de registros contidos na mesma
                For j = 0 To UBound(varIdioma)
                    'Se o nome do controle  e o nome do formulário equivale ao registro na variável,  aplica o memso no Rótulo
                    'e o nome do Formulário segundo o idoma selecionado
                    If Ctl.Name = CStr(varIdioma(9, j)) And Formulario.Name = CStr(varIdioma(1, j)) Then
                        Ctl.Caption = CStr(varIdioma(12, j))
                    End If
                Next
            'Aplica o Nome fo Formulário contido na tblForms segundo o idioma ao Caption do mesmo
            Formulario.Caption = CStr(varIdioma(4, j))
            End If
    'Encerro o Select
    End Select
'Próximo controle
Next Ctl
End Function

Enjoy!!!

*****************************************************************************************************************



Repositório de Exemplos Ms Access
Sala destinada à colocação de exemplos em Ms Access (Código aberto) de e para
todos os Utilizadores Cadastrados.
Não tirar duvidas nesta sala.