Menú Principal

Clics de vista de contenido : 60276

Traducir aplicaciones

En esta utilidad solo debemos tener una tabla que se puede llamar Idiomas compuesta de un
ID y tantos campos como idiomas queramos poner eje: Español, Ingles, Frances, Aleman.



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 Objeto.Caption = rst.Fields(strIdioma) 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, 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 ' Argumentos: Item ------> número de ID buscado ' Uso Mensage: MsgBox DaMsg(Item) ' 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 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