Visual Basic para Aplicaciones - Editar documentos WORD desde Macro en Excel

Life is soft - evento anual de software empresarial
   
Vista:
Imágen de perfil de Antoni Masana

Editar documentos WORD desde Macro en Excel

Publicado por Antoni Masana amasana@hotmail.com (154 intervenciones) el 16/05/2017 10:47:22
Buenas compañeros,

Estoy haciendo una Macro en Excel para abrir varios ficheros en Excel y en Word modificarlos y guardarlos en una nueva ubicación.

Tengo hecho:

* Buscar los diferentes ficheros Excel en una estructura de directorios.
* Abrir el Libro, modificarlo y guardarlo en la nueva ubicación.
* Buscar los diferentes ficheros WORD en una estructura de directorios.
* Abrir el Documento.
* Tengo el trozo de macro para modificar la cabecera del DOC pero solo funciona desde el propio Word.

Necesito saber como:

* Poder ejecutar esta Macro desde el Excel, que me modifique el documento Word, es decir que el objeto activo sea el Documento Word, que es de lo que se queja.
* Como guardar los diferentes tipos de documentos, es decir .DOC y .DOCX
* Como cerrar el Documento.

Esta super Macro debe modificar la cabecera de unos 200 documentos entre .XLS , .XLSX , .DOC y .DOCX y estaría bien que lo hiciese un solo proceso y me falta la parte de los ficheros Word.

Muchas 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

Editar documentos WORD desde Macro en Excel

Publicado por JuanC juanc2942@gmail.com (546 intervenciones) el 16/05/2017 12:25:00
te dejo algo que tengo desde hace bastante... (no es exactamente lo que necesitás pero seguro te sirve de algo)

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
Option Explicit
 
'//By JuanC - Ene. 2008
 
Sub SearchWordsInDoc()
Dim wDoc As Object
Dim wApp As Object
Dim fs As Variant
Dim lCount&, i&, sText$
Dim sFullName$, lOff&
 
Set fs = Application.FileSearch
 
Set wApp = GetWord
If wApp Is Nothing Then GoTo Fin
 
Application.ScreenUpdating = False
 
sText = "julio" '//Texto a buscar
 
Set fs = Application.FileSearch
With fs
     .LookIn = "c:\windows\escritorio\" '//Carpeta de búsqueda
     .SearchSubFolders = True
     .Filename = "*.doc"
     If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderAscending, AlwaysAccurate:=True) > 0 Then
        lCount = .FoundFiles.Count
        For i = 1 To lCount
            sFullName = .FoundFiles(i)
            Set wDoc = wApp.Documents.Open(sFullName)
            If Not wDoc Is Nothing Then
               If FindText(wDoc, sText) Then
                  [A1].Offset(lOff).Hyperlinks.Add Anchor:=[A1].Offset(lOff), Address:=wDoc.FullName, TextToDisplay:=Mid(sFullName, InStrRev(sFullName, "\") + 1)
                  lOff = lOff + 1
               End If
               wDoc.Close False
            End If
        Next
     End If
End With
 
wApp.Quit
 
Fin:
Application.ScreenUpdating = True
 
Set fs = Nothing
Set wApp = Nothing
Set wDoc = Nothing
End Sub
 
Private Function GetWord() As Object
On Error GoTo Create
Set GetWord = GetObject(, "Word.Application")
Exit Function
Create:
Set GetWord = CreateObject("Word.Application")
End Function
 
Private Function FindText(ByVal Doc As Object, ByVal sText As String) As Boolean
On Error Resume Next
With Doc.Content.Find
     .ClearFormatting
     If .Execute(FindText:=sText) Then
        FindText = True
     Else
          FindText = False
     End If
End With
End Function
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