Vamos encerar este Tópico com Chave de Ouro..1 - Criei a tblForms onde fica o nome do form e sua respectiva tradução nos idiomas
2 - Relacionado a tblForms à tblIdiomasRT
3 - Transformada em função o carregamento dos controles do form, para chamar a função no form basta no evento ao Carregar:
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
Início
![[Resolvido]Funçao DLookup no controle de idiomas Empty](https://2img.net/i/empty.gif)
luisaraujo 10/3/2013, 19:44
