Access - Access Word Campo Memo o largo

   
Vista:

Access Word Campo Memo o largo

Publicado por Rafi rafitruji@hotmail.com (66 intervenciones) el 31/07/2015 20:13:39
Hola a todos y gracias por la ayuda.
No tengo ni idea de como puedo implementar en un ejemplo que estoy intentando adaptar un campo Memo o Largo ya que al hacerlo me arroja error. Supongo el código que usa no está pensado para este tipo de campo.
Ruego a los moradores de este foro me ayuden o pongan en el camino. Os dejo el código que usa:


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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
Option Compare Database
Option Explicit
 
 
 
Private Sub ComandoInformePedidosClliente_Click()
 
    Dim informe As New ClaseInformeWord
    Dim filtro As String
 
    filtro = "cliente_id=" & Me.cliente_id
 
    Call informe.Abrir("informe_cliente_pedidos.dot")
    Call informe.Ejecutar("tabla_clientes", filtro)
    Call informe.EjecutarTablaDetalles(2, "consulta_pedidos", filtro)
    Call informe.Cerrar
 
    Set informe = Nothing
End Sub
 
 
 
 
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 NextOption Compare Database
Option Explicit
 
 
 
Private Sub ComandoInformePedidosClliente_Click()
 
    Dim informe As New ClaseInformeWord
    Dim filtro As String
 
    filtro = "cliente_id=" & Me.cliente_id
 
    Call informe.Abrir("informe_cliente_pedidos.dot")
    Call informe.Ejecutar("tabla_clientes", filtro)
    Call informe.EjecutarTablaDetalles(2, "consulta_pedidos", filtro)
    Call informe.Cerrar
 
    Set informe = Nothing
End Sub
 
 
 
 
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 = True
    Call SysCmd(acSysCmdRemoveMeter)
    DoCmd.Hourglass False
    Set appWord = Nothing
    Set documento_word = Nothing
    rs.Close: Set rs = Nothing
    Set campo = Nothing
    Exit Function
Errores:
    MsgBox Err.Description, vbCritical, "InformeWord"
    Resume Salida
End Function
    appWord.Visible = True
    Call SysCmd(acSysCmdRemoveMeter)
    DoCmd.Hourglass False
    Set appWord = Nothing
    Set documento_word = Nothing
    rs.Close: Set rs = Nothing
    Set campo = Nothing
    Exit Function
Errores:
    MsgBox Err.Description, vbCritical, "InformeWord"
    Resume Salida
End Function
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder