Código que funciona en el formulario pero no en un módulo
una vez más. A ver si me podéis orientar (algo que siempre habéis hecho y que os agradezco).
Veréis, la cuestión es la siguiente:
Desde un formulario tengo que mandar imprimir unas cartas (bueno, en realidad desde varios formularios, cada uno escribe un tipo de carta). Como quiera que mis jefes quieren que las cartas se impriman utilizando Word, hice lo siguiente:
El formulario desde el que mando imprimir las cartas (fprevoferta, p. Ejemplo) recoge toda la información que deberá aparecer en el escrito. Creo una plantilla en Word con un encabezado en el que va el logo de la empresa, el nombre y dirección de la tienda concreta que hace la oferta (son tres o cuatro tiendas las que tienen, no lo sé con seguridad ya que la familia está reñida y no sé si siguen siendo todas del mismo grupo o no...) y el título de la misma (p. Ejemplo "Ofertas de temporada"). Luego ya, en el cuerpo del documento van los datos del cliente y el texto en sí mismo (hablo de ofertas, pero también pueden ser informaciones con respecto a un pedido o notificaciones de otro tipo. En cualquier caso, el encabezado varía únicamente en el título, manteniéndose constante el resto) y, por último la firma que tengo guardada como imagen bmp en la base de datos al igual que el logo.
El logo, el título y el nombre de la tienda se colocan en una tabla de word en la que las celdas han sido dimensionadas conforme a nuestras pretensiones, al igual que la firma.
Una vez explicado esto os comento como hago:
En el formulario fprevoferta tengo un botón de comando con el siguiente código en el evento "al hacer click":
Dim word As New word.Application
Dim pruebarec As word.Document
Dim myrange As Range
Dim miruta As String
miruta = Application.CurrentProject.Path
& "\escritos\"
word.Visible
= True
Set escrito = word.Documents.Open(FileName:=miruta
& "ofertas.docx", ReadOnly:=True)
' Es a partir de aquí donde quiero introducir cambios
word.ActiveWindow.ActivePane.View.SeekView
= wdSeekCurrentPageHeader
With word.ActiveWindow.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "#título#"
.Replacement.Text = titulo
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
word.ActiveWindow.Selection.Find.Execute
With word.ActiveWindow.Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse
Direction:=wdCollapseStart
End If
.Find.Execute
End With
With word.ActiveWindow.Selection.Find
.Text = "#logo#"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
word.ActiveWindow.Selection.Find.Execute
With word.ActiveWindow.Selection
If .Find.Forward = True Then
.Collapse
Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse
Direction:=wdCollapseStart
End If
.Find.Execute
.InlineShapes.AddPicture FileName:= _
logo.Value, LinkToFile:= _
False, SaveWithDocument:=True
End With
With word.ActiveWindow.Selection.Find
.Text = "#nombretienda#"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
word.ActiveWindow.Selection.Find.Execute
With word.ActiveWindow.Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse
Direction:=wdCollapseStart
End If
.Find.Execute
.InlineShapes.AddPicture FileName:= _
nombretienda.Value, LinkToFile:= _
False, SaveWithDocument:=True
End With
word.ActiveWindow.ActivePane.View.SeekView
= wdSeekMainDocument
Set myrange
= word.ActiveDocument.Content
With myrange.Find
.ClearFormatting
.Text = "#texto#"
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
myrange.Text =ftexto
Loop
End With
With
myrange.Find
.ClearFormatting
.Text = "#firma#"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
myrange.Find.Execute
myrange.InlineShapes.AddPicture FileName:=
_
RUBRICA.Value, LinkToFile:= _
False, SaveWithDocument:=True
Si lo ejecuto desde el formulario funciona bien, ahora bien si lo coloco en un módulo a partir de la línea que he indicado y luego llamo a la función, funciona una vez sí y otra no alternativamente: me da un mensaje del tipo "el equipo servidor remoto está desconectado" o algo así, pero si cierro ese mensaje y vuelvo a pinchar en el botón de comando, vuelve a funcionar. ¿A qué puede deberse? Más que nada es para no tener que repetir el código en todos los formularios en los que tengo que usarlo.
Gracias por vuestra atención y perdón por el "tocho" que os he metido aquí.
1 respuesta
A ver si te puedo ayudar con esta, aunque no domino mucho el tema de word con access.
Veamos, si el código que pones ahí está completo, veo que le falta cerrar el objeto word:
Escrito. Quit
Set escrito=Nothing
Tampoco veo que declaras el objeto "escrito" (hay un "Dim pruebarec As word.Document", que no veo que lo uses, y no un "Dim escrito As word.Document")
Otra cosa:
Cuando pones el código en el módulo, tienes que poner el procedimiento/función como Public (imagino que esto si lo haces), y además, no puedes hacer referencia a los controles del formulario (por ejemplo, en esta linea ".Replacement.Text = titulo", supongo que titulo se refiere a un cuadro de texto llamado titulo de tu formulario fprevoferta )
Una forma de solucionar esto, es pasarle como parámetros esos valores al llamar a la función, por ejemplo:
Public Sub CartaWord(elTitulo as String, elLogo as String, laTienda as String)
...
.Replacement.Text = elTitulo
...
.InlineShapes.AddPicture FileName:= _
elLogo, LinkToFile:= _
False, SaveWithDocument:=True
...
.InlineShapes.AddPicture FileName:= _
laTienda, LinkToFile:= _
False, SaveWithDocument:=True
...
Y cuando la llames haces:
CartaWord titulo.value,logo.value,nombretienda.value
Esto lo tendrás que hacer en todas las partes que hagas referencia a controles del formulario, añadiendo tantos parámetros (del tipo que sean) como necesites y sustituyendo las referencias a los controles por lo nuevos parámetros.
¡Gracias!
Perdón por la tardanza, he estado haciendo pruebas para ver cómo funcionaría mejor y por eso no he respondido antes (a ninguna de las dos preguntas que hice :D) Al final he podido solucionarlo, aunque no como tu me comentabas, ya que me resultaba un poco complejo de hacer (mi falta de conocimientos es asombrosa...) Ahora bien, como quiera que una vez funcionaba y otra no, de forma alterna, lo que he hecho es lo siguiente (lo comento por si a alguien le puede servir):
En primer lugar, corregir lo que me comentabas y declarar el objeto "escrito" que, en efecto no había declarado (el Dim pruebarec viene de una prueba anterior que hice y que no corregí en su momento) después he añadido lo siguiente al principio de la función
Dim frm as Form
...
Set frm = Screen.ActiveForm
...
de esta forma declaro como formulario del que se tomarán los datos el formulario activo (la pantalla activa) en ese momento.
El resto del código queda igual salvo por una pequeña diferencia, en lugar de:
...
With myrange.Find
.ClearFormatting
.Text = "#texto#"
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
myrange.Text =ftexto
Loop
End With
...
lo que pongo es:
...
With myrange.Find
.ClearFormatting
.Text = "#texto#"
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
myrange.Text =frm.ftexto
Loop
End With
...
y así funciona de maravilla. Lo único que he de hacer es, en cada formulario añado un campo de texto llamado "paraimprimir" y le asigno un valor predeterminado (1, 2, 3...)
luego en el módulo pongo:
Dim word As New word.Application
Dim pruebarec As word.Document
Dim myrange As Range
Dim miruta As String
dim frm as Form
set frm = Screen.ActiveForm
miruta = Application.CurrentProject.Path
& "\escritos\"
word.Visible
= True
If frm.paraimprimir = 1 Then
Set escrito = word.Documents.Open(FileName:=miruta
& "ofertas.docx", ReadOnly:=True)
ElseIf frm.paraimprimir = 2 then
Set escrito = word.Documents.Open(FileName:=miruta
& "pedidos.docx", ReadOnly:=True)
...
End If
y de esta forma abro el escrito de word que necesito en cada caso. Del mismo modo, con sentencias If ... Then, modifico la parte de código que no es común a todos los formularios, pero la que sí es común (el encabezado, los datos de los clientes,...) solo aparece una vez, con el consiguiente ahorro de espacio...
Muchísimas gracias por tu respuesta, ya que, aunque en esta ocasión no la he utilizado, resulta una excelente guía para futuras ocasiones.
Ah! en efecto no había cerrado el objeto word, aunque en este caso sí que lo hice a idea, ya que lo que pretendo hacer es mandarlo imprimir directamente y después cerrarlo sin guardar cambios (eso ya lo he hecho antes) pero, por no imprimir una hoja con cada prueba, lo dejé así, sin mandar imprimir pero sin cerrar para poder comprobar si funcionaba o no ;)
Muchas gracias una vez más (seguiré incordiando y abusando de tu paciencia y buena fe, pero espero algún día poder servir también de ayuda a alguien que sepa menos que yo - si es que eso es posible :-D)
