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
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 idxLa 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 SubProbablemente 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
