Recorrer subformulario para comprobar checkbox
Tengo un subformulario el cual contiene un checkbox llamado "imprimir" en cada registro, me gustaría poner un botón en el formulario principal que detecte las casillas marcadas y ejecute un comando si la casilla esta marcada para cada registro marcado.
2 Respuestas
Prueba con este código:
Dim rst As DAO.Recordset Set rst=CurrentDb.OpenRecordset("NombreTabla/Consulta") If rst.EOF Then Exit Sub Do Until rst.EOF If rst("imprimir")=True Then 'Aquí el código que quieres ejecutar End If rst.MoveNext Loop rst.Close Set rst=Nothing
Para que te funcione, sólo tienes que poner en vez de "NombreTabla/Consulta", el nombre de tu tabla o consulta, y registrar la referencia Microsoft DAO 3.6 Object Library o Microsoft Office xx.x Access database engine Object Library
Antes que nada, muchas gracias por tu respuesta!, hasta hoy no he podido probar el código, estoy teniendo un problemilla, resulta que el comando a ejecutar es un modulo y por algún motivo no termina de detectarme el comando y me salta un error del estilo "se esperaba separador de lista" o "se esperaba numero de línea o etiqueta o declaración o fin de la instrucción"
¿Exite alguna forma de que detecte el modulo?
Parece que el error lo tienes en el código de tu módulo, ¿podrías ponerlo aquí, o pasarme una copia de tu BD (borra los datos "personales" que pudiera tener y deja un par de registros inventados)?
Con al información que me das, poco te puedo decir...
El fallo era en principio en que el código no debía llevar paréntesis en los parámetros cuando va insertado en código, aun así sigue sin funcionarme, la función la copie y adapte de otro usuario de internet, es esta:
Option Compare Database
Option Explicit
'REFERENCIAS NECESARIAS:
'Menú -> Herramientas -> Referencias -> Microsoft Word Object Library
Public Function InformeWord( _
ByVal plantilla_word As String, _
ByVal consulta As String, _
Optional ByVal filtro As String = "" _
) As Boolean
On Error GoTo Errores
'Ejemplo de uso (evento al hacer clic de un botón de comando):
'=InformeWord("informe_cliente.dot";"tabla_clientes";"cliente_id=" & cliente_id)
Dim rs As DAO.Recordset
Dim campo As DAO.field
Dim appWord As Word.Application
Dim documento_word As Word.Document
Dim ruta_actual As String
If filtro <> "" Then
consulta = "SELECT * FROM " & consulta & " WHERE " & filtro
End If
Set rs = CurrentDb.OpenRecordset(consulta, dbOpenForwardOnly)
If rs.BOF And rs.EOF Then
'Nada
Else
Set appWord = New Word.Application
appWord.Visible = False
Call SysCmd(acSysCmdInitMeter, "Exportando a Word", 100)
DoCmd.Hourglass True
If plantilla_word = "" Then
Set documento_word = appWord.Documents.Add()
Else
ruta_actual = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
Set documento_word = appWord.Documents.Add(ruta_actual & plantilla_word)
End If
For Each campo In rs.Fields
With appWord.Selection.Find
.ClearFormatting
.Text = "[" & UCase(campo.Name) & "]"
With .Replacement
.ClearFormatting
.Text = rs(campo.Name) & ""
End With
Call .Execute(Replace:=Word.WdReplace.wdReplaceAll)
End With
Next
End If
InformeWord = True
Salida:
On Error Resume Next
appWord.Visible = False
Call SysCmd(acSysCmdRemoveMeter)
DoCmd.Hourglass False
appWord.PrintOut Background:=False
Set appWord = Nothing
Set documento_word = Nothing
rs.Close: Set rs = Nothing
Set campo = Nothing
appWord.PrintOut Background:=False
Exit Function
Errores:
MsgBox Err.Description, vbCritical, "InformeWord"
Resume Salida
End Function
y el codigo que estoy usando ahora es:
Private Sub Comando44_Click()
Dim rst As DAO.Recordset
Set rst = Me!SubformularioTercerosConsulta4.Form.RecordsetClone
If rst.EOF Then Exit Sub
Do Until rst.EOF
If rst("imprimir") = True Then
InformeWord "informe_cliente.dot", "cuarteladas", "codigodifunto=" & "CodigoDifunto"
End If
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub
Con la recomendación de llodax de recorrer el propio subformulario.
El problema ahora viene en que me lee los checks, y me imprime el mismo numero de checks, pero los datos no coinciden para nada, de hecho siempre usa el mismo registro y ni siquiera esta marcado, supongo que el fallo esta en el modulo, cuando lo usaba desde macro lo usaba así:
=InformeWord("informe_cliente.dot";"cuarteladas";"codigodifunto=" & [codigodifunto])
Gracias de antemano
El problema lo tienes es esta linea: InformeWord "informe_cliente.dot", "cuarteladas", "codigodifunto=" & "CodigoDifunto"
Pues a la función InformeWord le estas pasando como criterio de la consulta que el campo codigodifunto sea igual a "CodigoDifunto"
Si codigodifunto es un campo que tienes en el propio subformulario, usa este código:
Private Sub Comando44_Click() Dim rst As DAO.Recordset Set rst = Me!SubformularioTercerosConsulta4.Form.RecordsetClone If rst.EOF Then Exit Sub rst.MoveFirst Do Until rst.EOF If rst("imprimir") = True Then InformeWord "informe_cliente.dot", "cuarteladas", "codigodifunto=" & rst("CodigoDifunto") End If rst.MoveNext Loop rst.Close Set rst = Nothing End Sub
Si por el contrario, codigodifunto está en el formulario principal, usa este otro:
Private Sub Comando44_Click() Dim rst As DAO.Recordset Set rst = Me!SubformularioTercerosConsulta4.Form.RecordsetClone If rst.EOF Then Exit Sub rst.MoveFirst Do Until rst.EOF If rst("imprimir") = True Then InformeWord "informe_cliente.dot", "cuarteladas", "codigodifunto=" & Me.CodigoDifunto End If rst.MoveNext Loop rst.Close Set rst = Nothing End Sub
A ver si así.
me ha funcionado perfectamente!, me estaba volviendo loco, ahora se imprime correctamente, solo me falta cerrar winword.exe al finalizar (por eso de que se abre en segundo plano), y aumentar en 1 el valor del campo avisos de la tabla cuarteladas, en que parte del codigo me recomiendas meterlo?
Aquí voy a dar un par de "palos de ciego":
Pon appWord.Close antes de Set appWord = Nothing en la función, para cerrar el word.
Para incrementar una unidad, usa una sql de actualización:
Dim miSQL as String
miSQL="UPDATE cuarteladas SET avisos=avisos+1"
CurrentDb.Execute miSQL
Si quieres actualizar un registro específico, tendrás que indicarle con un WHERE cual es, por ejemplo: miSQL="UPDATE cuarteladas SET avisos=avisos+1 WHERE codigodifunto= & Me.codigodifunto
En cuanto a dónde colocarlo, dependerá de si quieres hacerlo una vez cada vez que imprimas el word, en cuyo caso tend´ra que ir dentro del bucle Do... Loop, o una única vez al pulsar el botón, en cuyo caso lo pondrás fuera del Do... Loop.
estoy muy muy agradecido por toda la ayuda que me estas brindando, ese update no me esta funcionando porque supongo que no estoy haciendo referencia a codigodifunto correctamente, el loop se ejecuta desde el formulario y ahi no existe codigodifunto, sino en el subformulario, sin embargo no consigo hacer referencia al campo codigodifunto del subformulario, ni con rst(codigodifunto), ni de ninguna otra forma que se me ocurra, por otro lado, como podria poner un if que imprima informeclientes2.dot si el campo avisos en cuarteladas es 2 e informeclientes3.dot si es 3?, tengo 3 modelos de carta dependiendo del numero de avisos.
muchas gracias de antemano, de verdad.
Intuyo que quieres hacer algo así:
Private Sub Comando44_Click() Dim rst As DAO.Recordset Dim numAvisos as Integer Dim laPlantilla as String Set rst = Me!SubformularioTercerosConsulta4.Form.RecordsetClone If rst.EOF Then Exit Sub rst.MoveFirst Do Until rst.EOF 'Buscamos el número de avisos numAvisos=Nz(DLookUp("avisos","cuarteladas", "codigodifunto=" & rst("CodigoDifunto"),0) 'Si el check "imprimir" está marcado If rst("imprimir") = True Then 'Analizamos el numero de avisos, imprimiendo el informe correspondiente Select Case numAvisos Case 1 laPlantilla= "informe_cliente.dot" Case 2 laPlantilla= "informeclientes2.dot" Case 3 laPlantilla= "informeclientes3.dot" Case Else 'Si el num de avisos no es 1, 2, 3, pasas al siguiente registro del subformulario Goto Siguiente End Select 'Imprimes el word correspondiente: InformeWord laPlantilla, "cuarteladas", "codigodifunto=" & rst("CodigoDifunto") 'Incrementas aviso en uno Dim miSQL as String miSQL="UPDATE cuarteladas SET avisos=avisos+1 WHERE codigodifunto= & rst("CodigoDifunto") CurrentDb.Execute miSQL End If Siguiente: rst.MoveNext Loop rst.Close Set rst = Nothing End Sub
Me da el siguiente error:
Error de compilación:
El numero de argumentos es incorrecto o la asignación de propiedad no es valida.
Eso me lo dice sobre el Dlookup incluso después de añadir el paréntesis que falta al final.
y el update me da un error de sintaxis
Creo que faltan unas comillas para cerrar la instrucción, pero si las coloco al final dice que espera fin de la instrucción
Me comí un paréntesis en el DLookup:
numAvisos=Nz(DLookUp("avisos","cuarteladas", "codigodifunto=" & rst("CodigoDifunto")),0)
Y en la SQL de update, me faltan unas comillas:
miSQL="UPDATE cuarteladas SET avisos=avisos+1 WHERE codigodifunto=" & rst("CodigoDifunto")
- Compartir respuesta
En base al código de Sveinbjonr, se podría modificar para que abra el recordset del subformulario directamente
Set rst = Me!elControlSubformulario.Form.RecordsetClone
- Compartir respuesta