Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Access » Imprimir memos de Access a Word

Access - Imprimir memos de Access a Word

Volver
Nuevo Tema
Filtrado por el usuario: Oscar Pallud
<<>>
Filtrado por el usuario 'Oscar Pallud' (Eliminar fitro)
 
Vista:

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:

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
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de douglas

Imprimir memos de Access a Word

Publicado por douglas (280 intervenciones) el 17/02/2016 00:34:29
Muy bueno modulo se me hace conocido el creador

y como lo aplicaste para poder ayudarte?
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Imprimir memos de Access a Word

Publicado por Criss Vega (3 intervenciones) el 17/02/2016 13:26:27
Hola, gracias por responder,
no entendí tu pregunta de como lo apliqué.
Estoy ocupando Microsoft Access 2010, y lo que hace el programa es imprimir datos de los campos de un consulta en access, en un word que abre automáticamente al meter una llave en un formulario.
por ej en la plantilla word dice [edad], y segun el id que ingresé, se imprimirá la edad correspondiente.
Gracias de antemano.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de douglas

Imprimir memos de Access a Word

Publicado por douglas (280 intervenciones) el 17/02/2016 15:41:14
Ese código es como lo tienes en tu sistema? o es el que copiaste de la web
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Imprimir memos de Access a Word

Publicado por Criss Vega (3 intervenciones) el 17/02/2016 16:30:32
Si, es así como lo tengo en mi Access, tengo problemas en la parte Ejecutar

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

me tira error de que el parametro de la cadena es muy largo, como le hago para imprimir memos?
Muchas gracias.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar