Sub LlamarWriter()
Set oServicio = CreateObject("com.sun.star.ServiceManager")
Set Escritorio = oServicio.createInstance("com.sun.star.frame.Desktop")
Dim args(1) As Object
Set args(0) = oServicio.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
args(0).Name = "Hidden"
args(0).Value = True
Set Document = Escritorio.loadComponentFromURL("private:factory/swriter", "_blank", 0, args)
Call Document.getCurrentController.getFrame.getContainerWindow.setVisible(True)
Call Document.getCurrentController.getFrame.getComponentWindow.setVisible(True)
Set Document = Nothing
Set Escritorio = Nothing
Set oServicio = Nothing
End Sub
Private Sub boton_Click()
Dim dbLocal As Database
Dim snpReplaceCodes As Recordset
Dim strCurrAppDir As String
Dim strFinalDoc As String
Dim varReplaceWith As Variant
Dim docWord As Word.Document
On Error GoTo Error_boton_Click
Set dbLocal = CurrentDb()
strCurrAppDir = Left$(dbLocal.Name, InStrRev(dbLocal.Name, "\"))
strFinalDoc = strCurrAppDir & "plantilla1.dot"
On Error GoTo Error_boton_Click
Set appWord = New Word.Application
Set docWord = appWord.Documents.Add(strFinalDoc)
appWord.Visible = True
'abro ahora la tabla de las sustituciones
Set snpReplaceCodes = dbLocal.OpenRecordset("ReemplazaCodigos", _
dbOpenSnapshot)
Do While Not snpReplaceCodes.EOF
varReplaceWith = Eval(snpReplaceCodes!ReplaceWithFieldName)
varReplaceWith = IIf(IsNull(varReplaceWith), " ", CStr(varReplaceWith))
With docWord.Content.Find
If snpReplaceCodes!CodeToReplace = "{MOVIETITLE}" Then
With .Replacement
.ClearFormatting
.Font.Bold = True
.Font.Italic = True
End With
End If
.Execute FindText:=snpReplaceCodes!CodeToReplace, _
ReplaceWith:=varReplaceWith, Format:=True, _
Replace:=wdReplaceAll
End With
snpReplaceCodes.MoveNext
Loop
snpReplaceCodes.Close
docWord.SaveAs FileName:="C:\Documentos\Datos.doc"
docWord.Close
appWord.Quit
Exit Sub
Error_boton_Click:
Beep
' MsgBox "Ha ocurrido el error:" & vbCrLf & _
' Err.Description, vbCritical, "OLE Error!"
Exit Sub
End Sub
Set appWord = New Word.Application
Set docWord = appWord.Documents.Add(strFinalDoc)
appWord.Visible = True
Sub Ejemplo53()
Set oServicio = CreateObject("com.sun.star.ServiceManager")
Set Escritorio = oServicio.createInstance("com.sun.star.frame.Desktop")
Dim args(1) As Object
Set args(0) = oServicio.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
args(0).Name = "Hidden"
args(0).Value = True
Set Document = Escritorio.loadComponentFromURL("private:factory/scalc", "_blank", 0, args)
Set oHoja = Document.getSheets().getByIndex(0)
Call oHoja.getcellbyposition(0, 0).setFormula("fornelasa")
Call oHoja.getcellbyposition(0, 0).SetPropertyValue("CellBackColor", RGB(100, 250, 100))
Call oHoja.getcellbyposition(0, 1).setFormula("El Foro")
Call oHoja.getcellbyposition(0, 1).SetPropertyValue("CellBackColor", RGB(100, 250, 100))
Call Document.getCurrentController.getFrame.getContainerWindow.setVisible(True)
Call Document.getCurrentController.getFrame.getComponentWindow.setVisible(True)
Set oHoja = Nothing
Set Document = Nothing
Set Escritorio = Nothing
Set oServicio = Nothing
End Sub
appWord.Visible = True
es decir, hasta ahi llegamosllamar a Writer desde Access VBA
Dim dbLocal As Database
Dim snpReplaceCodes As Recordset
Dim strCurrAppDir As String
Dim strFinalDoc As String
Dim varReplaceWith As Variant
Dim docWord As Word.Document
On Error GoTo Error_boton_Click
Set dbLocal = CurrentDb()
strCurrAppDir = Left$(dbLocal.Name, InStrRev(dbLocal.Name, "\"))
strFinalDoc = strCurrAppDir & "plantilla1.dot"
On Error GoTo Error_boton_Click
strFinalDoc = Replace(strFinalDoc, "\", "/")
strFinalDoc = "file:///" + strFinalDoc
Dim args(1) As Object
Set oServicio = CreateObject("com.sun.star.ServiceManager")
Set Escritorio = oServicio.createInstance("com.sun.star.frame.Desktop")
Set args(0) = oServicio.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
args(0).Name = "Hidden"
args(0).Value = True
Set Document = Escritorio.loadComponentFromURL(strFinalDoc, "_blank", 0, args())
Call Document.getCurrentController.getFrame.getContainerWindow.setVisible(True)
Call Document.getCurrentController.getFrame.getComponentWindow.setVisible(True)
xiseme escribió:@fornelasa ¿podría abrirse una plantilla de writer desde VBA?
Sub LlamarPlantillaWriter()
Dim args(1) As Object
archivo = "file:///C:/Users/Federico/Documents/AAAAAAA/plantilla1.ott" 'OJO OJO aqui va tu carpeta
Set oServicio = CreateObject("com.sun.star.ServiceManager")
Set Escritorio = oServicio.createInstance("com.sun.star.frame.Desktop")
Set args(0) = oServicio.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
args(0).Name = "Hidden"
args(0).Value = True
Set Document = Escritorio.loadComponentFromURL(archivo, "_blank", 0, args())
Call Document.getCurrentController.getFrame.getContainerWindow.setVisible(True)
Call Document.getCurrentController.getFrame.getComponentWindow.setVisible(True)
End Sub
OServicio
Escritorio
Document
Dim OServicio As Object
Dim Escritorio As Object
Dim Document As Object
[color=#BF0080]Private Sub Comando367_Click()
Dim dbLocal As Database
Dim snpReplaceCodes As Recordset
Dim strCurrAppDir As String
Dim strFinalDoc As String
Dim varReplaceWith As Variant
Dim docWord As Word.Document
Dim OServicio As Object
Dim Escritorio As Object
Dim Document As Object
On Error GoTo Error_Comando367_Click
Set dbLocal = CurrentDb()
strCurrAppDir = Left$(dbLocal.Name, InStrRev(dbLocal.Name, "\"))
strFinalDoc = strCurrAppDir & "certificado.dot"
On Error GoTo Error_Comando367_Click
strFinalDoc = Replace(strFinalDoc, "\", "/")
strFinalDoc = "file:///" + strFinalDoc
Dim args(1) As Object
Set OServicio = CreateObject("com.sun.star.ServiceManager")
Set Escritorio = OServicio.createInstance("com.sun.star.frame.Desktop")
Set args(0) = OServicio.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
args(0).Name = "Hidden"
args(0).Value = True
Set Document = Escritorio.loadComponentFromURL(strFinalDoc, "_blank", 0, args())
Call Document.getCurrentController.getFrame.getContainerWindow.setVisible(True)
Call Document.getCurrentController.getFrame.getComponentWindow.setVisible(True)
'abro ahora la tabla de las sustituciones
Set snpReplaceCodes = dbLocal.OpenRecordset("ReemplazaCertificado", _
dbOpenSnapshot)
Do While Not snpReplaceCodes.EOF
varReplaceWith = Eval(snpReplaceCodes!ReplaceWithFieldName)
varReplaceWith = IIf(IsNull(varReplaceWith), " ", CStr(varReplaceWith))
With docWord.Content.Find
If snpReplaceCodes!CodeToReplace = "{MOVIETITLE}" Then
With .Replacement
.ClearFormatting
.Font.Bold = True
.Font.Italic = True
End With
End If
.Execute FindText:=snpReplaceCodes!CodeToReplace, _
ReplaceWith:=varReplaceWith, Format:=True, _
Replace:=wdReplaceAll
End With
snpReplaceCodes.MoveNext
Loop
snpReplaceCodes.Close
Exit Sub
Error_Comando367_Click:
Beep
' MsgBox "Ha ocurrido el error:" & vbCrLf & _
' Err.Description, vbCritical, "OLE Error!"
Exit Sub
End Sub[/color]
maserrano escribió:El resultado es que me abre LibreOfficce y me abre el documento plantilla (dot)
maserrano escribió:pero no me hace las sustituciones.
Qué hago mal?
Editado: Toma en cuenta que este es un foro de OpenOffice y no de VBA, Access, Word y compañia ![]() |
Public Sub utilizaopenoffice_Click()
Dim dbLocal As Database
Dim snpReplaceCodes As Recordset
Dim strCurrAppDir As String
Dim strFinalDoc As String
Dim varReplaceWith As Variant
'++++++++++++++
Dim mibusqueda As Object
Dim oservicio As Object
Dim Escritorio As Object
Dim document As Object
'++++++++++++++++
On Error GoTo Error_utilizaopenoffice_Click
Set dbLocal = CurrentDb()
strCurrAppDir = Left$(dbLocal.Name, InStrRev(dbLocal.Name, "\"))
strFinalDoc = strCurrAppDir & "plantilla1.dot"
'también puede ser plantilla1.ott
On Error GoTo Error_utilizaopenoffice_Click
strFinalDoc = Replace(strFinalDoc, "\", "/")
strFinalDoc = "file:///" + strFinalDoc
Dim args(1) As Object
Set oservicio = CreateObject("com.sun.star.ServiceManager")
Set Escritorio = oservicio.createInstance("com.sun.star.frame.Desktop")
Set args(0) = oservicio.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
args(0).Name = "Hidden"
args(0).Value = True
Set document = Escritorio.loadComponentFromURL(strFinalDoc, "_blank", 0, args())
Call document.getCurrentController.getFrame.getContainerWindow.setVisible(True)
Call document.getCurrentController.getFrame.getComponentWindow.setVisible(True)
Set mibusqueda = document.createReplaceDescriptor
'abro ahora la tabla de las sustituciones
Set snpReplaceCodes = dbLocal.OpenRecordset("ReemplazaCodigos", _
dbOpenSnapshot)
Do While Not snpReplaceCodes.EOF
varReplaceWith = Eval(snpReplaceCodes!ReplaceWithFieldName)
varReplaceWith = IIf(IsNull(varReplaceWith), " ", CStr(varReplaceWith))
mibusqueda.setsearchstring (snpReplaceCodes!CodeToReplace)
mibusqueda.setreplacestring (varReplaceWith)
Call document.replaceall(mibusqueda)
snpReplaceCodes.MoveNext
Loop
'
snpReplaceCodes.Close
Exit Sub
Error_utilizaopenoffice_Click:
Beep
' MsgBox "Ha ocurrido el error:" & vbCrLf & _
' Err.Description, vbCritical, "OLE Error!"
Exit Sub
End Sub
xiseme escribió:Uno por lograrlo y otro
por poner la solución.
Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 3 invitados