Access - Access Word Campo Memo o largo

Access Word Campo Memo o largo

Publicado por Rafi (71 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:

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 clara

No me gusta: Está pregunta no esta clara o no es útil

Responder