Imprimir memos de Access a Word
Publicado por Criss Vega (3 intervenciones) el 15/02/2016 15:02:06
Hola muchach@s!
encontré el siguiente código en VB en Internet, que es para imprimir datos del Access en un Word,
mi problema es que no imprime datos del tipo Memo, y me gustaria que lo hiciese, aqui va el codigo:
GRACIAS!
encontré el siguiente código en VB en Internet, que es para imprimir datos del Access en un Word,
mi problema es que no imprime datos del tipo Memo, y me gustaria que lo hiciese, aqui va el codigo:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
Option Compare Database
Option Explicit
Private app_word As Word.Application
Private documento_word As Word.Document
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
Call Cerrar
End Sub
Public Function Abrir(ByVal plantilla_word As String)
Dim ruta_actual As String
Set app_word = New Word.Application
app_word.Visible = False
If plantilla_word = "" Then
Set documento_word = app_word.Documents.Add()
Else
ruta_actual = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
Set documento_word = app_word.Documents.Add(ruta_actual & plantilla_word)
End If
End Function
Public Function Cerrar()
On Error Resume Next
app_word.Visible = True
Set app_word = Nothing
Set documento_word = Nothing
End Function
Public Function Ejecutar( _
ByVal consulta As String, _
Optional ByVal filtro As String = "" _
) As Boolean
On Error GoTo Errores
Call SysCmd(acSysCmdInitMeter, "Exportando a Word: " & consulta, 9999)
DoCmd.Hourglass True
Dim rs As DAO.Recordset
Dim field As DAO.field
If filtro <> "" Then consulta = "SELECT * FROM " & consulta & " WHERE " & filtro
Set rs = CurrentDb.OpenRecordset(consulta, dbOpenForwardOnly)
If rs.BOF And rs.EOF Then
Else
For Each field In rs.Fields
With app_word.Selection.Find
.ClearFormatting
.Text = "[" & UCase(field.Name) & "]"
With .Replacement
.ClearFormatting
.Text = rs(field.Name) & ""
End With
Call .Execute(Replace:=Word.WdReplace.wdReplaceAll)
End With
Next
End If
Ejecutar = True
Salida:
Call SysCmd(acSysCmdRemoveMeter)
DoCmd.Hourglass False
Exit Function
Errores:
MsgBox Err.Description, vbCritical, "Ejecutar"
Resume Salida
End Function
Public Function EjecutarTablaDetalles( _
ByVal num_tabla As Integer, _
ByVal consulta As String, _
Optional ByVal filtro As String = "" _
) As Boolean
On Error GoTo Errores
Call SysCmd(acSysCmdInitMeter, "Exportando a Word: " & consulta, 9999)
DoCmd.Hourglass True
Dim rs As DAO.Recordset
Dim field As DAO.field
Dim tabla As Word.Table
Dim ultima_fila As Word.row, nueva_fila As Word.row
Dim celda As Word.Cell
Dim campo As String, VALOR As String
If filtro <> "" Then consulta = "SELECT * FROM " & consulta & " WHERE " & filtro
Set rs = CurrentDb.OpenRecordset(consulta, dbOpenForwardOnly)
Set tabla = documento_word.Tables(num_tabla)
If rs.BOF And rs.EOF Then
Else
Do Until rs.EOF
Set ultima_fila = tabla.Rows(tabla.Rows.Count)
Set nueva_fila = tabla.Rows.Add
For Each celda In ultima_fila.Cells
campo = celda.Range.Text
campo = Left(campo, Len(campo) - 2)
nueva_fila.Cells(celda.ColumnIndex).Range.Text = campo
For Each field In rs.Fields
If 0 <> InStr(LCase(field.Name), "importe") Then
VALOR = Format(Nz(rs(field.Name), 0), "#,##0.00")
Else
VALOR = rs(field.Name) & ""
End If
campo = Replace(campo, "[" & field.Name & "]", VALOR)
Next
celda.Range.Text = campo
Next
rs.MoveNext
Loop
End If
tabla.Rows(tabla.Rows.Count).Delete
EjecutarTablaDetalles = True
Salida:
Call SysCmd(acSysCmdRemoveMeter)
DoCmd.Hourglass False
Exit Function
Errores:
MsgBox Err.Description, vbCritical, "EjecutarTablaDetalles"
Resume Salida
End Function
GRACIAS!
Valora esta pregunta


0