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

Respuesta
1

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")

Funcionar funciona el botón, lo "unico" que ocurre es que el botón comando44 solo funciona una vez, si le doy una segunda no hace nada, tengo que cerrar y abrir el formulario principal, ¿por qué podría ser?

Ponle un Me. Requery al finalizar el código (antes del End Sub), a ver si así. Es lo único que se me ocurre, porque no tengo ni idea del motivo de ese comportamiento...

Respuesta
1

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas