Reemplazar marcadores en Tabla desde subformulario Access en documento Word

Hace unos días he consultado acerca del tema de reemplazar los bookmarks en un documento Word para generar cartas y gracias a vuestra ayuda lo he solucionado pero ahora me ha surgido otro tema que es el de insertar en el mismo documento unas Tablas (tipo excel) y en las celdas otros bookmarks a partir de los registro de un subformulario (tipo descripción de factura) y que las filas se incrementen de acuerdo a necesidad. Anteriormente he utilizado el siguiente código vba para los bookmarks desde el form:

Private Sub BtnImpCARTA_Click()
On Error GoTo Err_cmdCombinar
Dim AppWord As Word.Application
Dim DocWord As Word.Document
Dim Texto As String

Dim fileName As String

Dim Plantilla As String
Dim DirNotas As String
Plantilla = Application.CurrentProject.Path & "\WordPlantilla\NOTA_ACUSE_RC_2020.dotx"
DirNotas = Application.CurrentProject.Path & "\Acuses\"

AppWord.Documents.Add Template:=Plantilla, NewTemplate:=False
Set DocWord = AppWord.ActiveDocument
If DocWord.Bookmarks.Exists("Marcador1") Then
        If Not IsNull(Campo1) Then
        DocWord.Bookmarks("Marcador1").Select
       Texto = Campo1
       DocWord.Application.Selection.TypeText Text:=Texto
       End If
End If

.... Y ASI SUCESIVAMENTE CON TODOS LOS MARCADORES

AppWord.Visible = True
AppWord.ActiveDocument.SaveAs2 fileName
AppWord.WindowState = wdWindowStateMaximize
Exit_cmdCombinar:
DoCmd.Hourglass False

MsgBox "SE HA GENERADO LA CARTA CON ÉXITO", vbInformation, "Aviso"

Exit Sub

Err_cmdCombinar:

If Err = 91 Or Err = -2147023174 Then
Set AppWord = New Word.Application
Resume
End If

'bloqueo boton
Me.BtnImpCARTA.Enabled = False
End Sub

La cuestión es que ahora tengo esos datos en el subform y necesitaría de vuestra sabiduría para saber como hacerlo y adaptarlo al código que ya tengo.

1 Respuesta

Respuesta
1

Hasta donde yo sé, usando marcadores no creo que lo puedas conseguir, porque a cada celda le tendrás que colocar un marcador en el word y no puedes crear nuevas celdas con nuevos marcadores en el momento de pasar los datos.

Quizás una solución que se sirva sea insertar directamente en el word la tabla o consulta, aunque supongo que pierdes control sobre el formato. Aquí tienes explicado cómo hacerlo: http://neckkito.xyz/nck/index.php/teoria/sabiais-que-existe/consulta-en-word

¡Gracias! 

Por curiosidad, ¿te sirvió la propuesta?

En realidad es muy útil si el formulario está basado en una consulta, pero en mi caso el formulario tiene por origen de datos sólo las tablas con un sub form y un botón que genera -por el momento- un report access con un filtro. Mi intención -como la de varios en la web- es poder aplicar el código para generar ése informe en word para hacerlo más amigable a las ediciones. De todas formas me serviría insertar tal vez cómo objeto el subform pero no tengo idea. De todas maneras gracias!

Hola!. De nuevo yo. Luego de buscar he dado con el siguiente código:

Private Sub btn_ImpReclamOBSWord_Click()
10   On Error GoTo ErrorTrap
20 Const TemplatePath As String = "C:\Users\miUsuario\WordPlantilla\carta_reclamo.dotx"
    'SaveAs
30    Dim name_ As String
        name_ = "C:\Users\miUsuario\Reclamos" & "RECLAMO-" & Me.RefEntrada & ".docx"
    'Word
40     Dim oWord As Word.Application
50     Set oWord = New Word.Application
60        oWord.Visible = True
70     Dim oDoc As Word.Document
80     Set oDoc = oWord.Documents.Add(TemplatePath)
90     With oDoc
100        .Bookmarks("MisionRemite1").Range.Text = Nz(Me![MisionRemite], "")
110        .Bookmarks("MesRendido").Range.Text = Nz(Me![MesRendido], "")
120        .Bookmarks("EjerFiscal").Range.Text = Nz(Me![EjerFiscal], "")
130        .Bookmarks("SiglaEntrante").Range.Text = Nz(Me![SiglaEntrante], "")
140        .Bookmarks("RefEntrada").Range.Text = Nz(Me![RefEntrada], "")
150        .Bookmarks("MisionRemite2").Range.Text = Nz(Me![MisionRemite], "")
160        .Bookmarks("FechaActual").Range.Text = Format(Date, "d"" de ""mmmm"" del ""yyyy")
170        .Bookmarks("MisionRemite3").Range.Text = Nz(Me![MisionRemite], "")
180        .Bookmarks("DireccMision").Range.Text = Nz(Me![DireccMision], "")
190        .Bookmarks("FuncReg").Range.Text = Nz(Me![FuncReg], "")
200     End With
210 Dim rs As Recordset: Set rs = Me.[SubformOBS].Form.RecordsetClone
220    With rs
230        .MoveLast
240          If Not .EOF Then
250            .MoveLast
260            .MoveFirst
270          End If
280    End With
'SI OBVIO ESTA PARTE FUNCIONA PERFECTO O 
'SI EN LA PLANTILLA FALTASE UNA COLUMNA COMPLETA UNA LINEA
290    Dim idx As Integer
300    For idx = 1 To rs.RecordCount
310        With oDoc.Tables(1)
320            .Cell(idx, 1).Range.Text = rs.AbsolutePosition + 1
330            .Cell(idx, 2).Range.Text = Nz(rs![RubroOBS], "")
340            .Cell(idx, 3).Range.Text = Nz(rs![NroCompOBS], "")
350            .Cell(idx, 4).Range.Text = Nz(rs![FechaCompOBS], "")
360            .Cell(idx, 5).Range.Text = Nz(rs![MontoMLOBS], "")
370            .Cell(idx, 6).Range.Text = Nz(rs![MontoUSDOBS], "")
380            .Cell(idx, 7).Range.Text = Nz(rs![MontoReclamadoUSD], "")
390            .Cell(idx, 8).Range.Text = Nz(rs![OBS], "")
400            .Cell(idx, 9).Range.Text = Nz(rs![FechaHoraRegOBS], "")
410            .Cell(idx, 10).Range.Text = Nz(rs![FuncRegOBS], "")
420            If rs.AbsolutePosition <> rs.RecordCount - 1 Then .Columns(1).Cells.Add
430        End With
440        rs.MoveNext
450    Next idx

La cuestión es que al llegar a la instancia With oDoc.Tables (1) me saltaba un error que era porque había puesto una columna menos en la tabla de la plantilla, pero completaba las celdas de la primera fila hasta el error. Ahora, ya habiendo puesto la columna faltante, no ocurre absolutamente nada.

Evidentemente algo lo hago mal. Espero puedas ayudarme.

Saludos y gracias!

Tengo que probar el código a ver cómo funciona para decirte algo, pero este fin de semana no creo que pueda. En unos días (seguramente el lunes) te diré algo.

Ok. Esperaré pacientemente, desde ya agradecido!

Buenas!. Finalmente el código ha funcionado de la siguiente forma:

10   On Error GoTo ErrorTrap
20 Dim Plantilla As String
30 Dim DirNotas As String
'HE DECLARADO ESTAS VARIABLES PARA LAS RUTAS DE PLANTILLAS Y GUARDAR LAS CARTAS 
40 Plantilla = Application.CurrentProject.Path & "\WordPlantilla\CARTA_RECLAMO.dotx"
50 DirNotas = Application.CurrentProject.Path & "\Reclamos\"
    'SaveAs
60    Dim name_ As String
        name_ = DirNotas & "RECLAMO-" & Me.RefEntrada & ".docx"
    'Word
70     Dim oWord As Word.Application
80     Set oWord = New Word.Application
90        oWord.Visible = True
' ESTA FORMA DE REEMPLAZAR MARCADORES ME RESULTO MAS CONVENIENTE
100     Dim oDoc As Word.Document
110     Set oDoc = oWord.Documents.Add(Plantilla)
120     With oDoc
130        .Bookmarks("MisionRemite1").Range.Text = Nz(Me![MisionRemite], "")
140        .Bookmarks("MesRendido").Range.Text = Nz(Me![MesRendido], "")
150        .Bookmarks("EjerFiscal").Range.Text = Nz(Me![EjerFiscal], "")
160        .Bookmarks("SiglaEntrante").Range.Text = Nz(Me![SiglaEntrante], "")
170        .Bookmarks("RefEntrada").Range.Text = Nz(Me![RefEntrada], "")
180        .Bookmarks("MisionRemite2").Range.Text = Nz(Me![MisionRemite], "")
190        .Bookmarks("FechaActual").Range.Text = Format(Date, "d"" de ""mmmm"" del ""yyyy")
200        .Bookmarks("MisionRemite3").Range.Text = Nz(Me![MisionRemite], "")
210        .Bookmarks("DireccMision").Range.Text = Nz(Me![DireccMision], "")
220        .Bookmarks("FuncReg").Range.Text = Nz(Me![FuncReg], "")
230     End With
'ASI OBTENEMOS LOS DATOS DEL SUBFORM Y LO INSERTAMOS A LA TABLA WORD
240 Dim rs As Recordset: Set rs = Me.[SubformOBS].Form.RecordsetClone
250     With rs
260            .MoveLast
270        If Not .EOF Then
280            .MoveLast
290            .MoveFirst
300        End If
310    End With
320    Dim idx As Integer
330    For idx = 1 To rs.RecordCount
340        With oDoc.Tables(2)
350            .Cell(idx, 1).Range.Text = rs.AbsolutePosition + 1
360            .Cell(idx, 2).Range.Text = Nz(rs![RubroOBS], "")
370            .Cell(idx, 3).Range.Text = Nz(rs![NroCompOBS], "")
380            .Cell(idx, 4).Range.Text = Nz(rs![FechaCompOBS], "")
390            .Cell(idx, 5).Range.Text = Nz(rs![MontoMLOBS], "")
400            .Cell(idx, 6).Range.Text = Nz(rs![MontoUSDOBS], "")
410            .Cell(idx, 7).Range.Text = Nz(rs![MontoReclamadoUSD], "")
420            .Cell(idx, 8).Range.Text = Nz(rs![OBS], "")
430            .Cell(idx, 9).Range.Text = Nz(rs![FechaHoraRegOBS], "")
440            .Cell(idx, 10).Range.Text = Nz(rs![FuncRegOBS], "")
450            If rs.AbsolutePosition <> rs.RecordCount - 1 Then .Columns(1).Cells.Add
460        End With
470        rs.MoveNext
480    Next idx
      'FINALMENTE GUARDAMOS LA CARTA
490    With oDoc
500        .SaveAs fileName:=name_, FileFormat:=Word.WdSaveFormat.wdFormatXMLDocument
510        .Close SaveChanges:=wdDoNotSaveChanges
520    End With
'AQUI EL AVISO QUE TODO HA IDO BIEN Y SI QUIEREMOS ABRIR LA CARPETA DONDE ESTA LA CARTA GENERADA
530    If MsgBox("Se ha generado la nota de Reclamo correctamente.¿Desea abrir la carpeta?", vbYesNo, "AVISO") = vbYes Then
540            Shell "C:\WINDOWS\Explorer.exe """ & DirNotas & "", vbNormalFocus
550    End If
Leave:
560   On Error Resume Next
570       rs.Close
580   Set rs = Nothing
590       oWord.Quit
600   Set oWord = Nothing
610   On Error GoTo 0
620   Exit Sub
ErrorTrap:
630    MsgBox Err.Description, vbCritical, "ExportToWord()" & Erl
640    Resume Leave
End Sub

Probablemente haya una mejor forma de hacerlo pero es la que ahora me ha funcionado. Como detalle comento que he tenido que crear dos tablas, una solo con las cabeceras de columnas y la otra donde incluir los datos, pues no he pillado como incluis las cabeceras por código. También he querido insertar datos de un textbox del subform con info de la suma de algunas columnas pero no he podido. De momento he salvado la situación. Muchas gracias por tu ayuda!.  

Como veo que lo has resuelto, y últimamente ando un poco liado, doy por solucionado el tema. Si más adelante ando un poco más libre, y como es algo que también me interesa, intentaré replicar lo que tienes y analizar el código y si puedo mejorar el código, te lo hago saber.

Para el tema del marcador que debe coger el valor del subformulario, solo has de indicárselo:

. Bookmarks("NombreMarcador"). Range.Text = Nz(Me. NombreControlSubformulario.Form.NombreCuadroTexto, "")

Aquí tienes explicada toda la casuística: http://www.llodax.com/Tutoriales/SintaxisSubForms.htm

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas