Potřeboval bych poradit mám cca 200 souborů s příponou .doc v jedném adresáři a potřeboval bych macro na to aby mě to automaticky otevřelo soubor a zaplo druhé macro které pozmění něco ve wordu a následně uložilo a tak by to pokračovalo do konce složky. používám word 2013
zkoušel jsem toto:
Private Sub Document_Open()
Selection.Find.ClearFormatting
With Selection.Find.Font
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = False
.Subscript = False
End With
With Selection.Find
.Text = "^t"
.Replacement.Text = "^t"
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Save
ActiveDocument.Close
End Sub
jenže to nefunguje když otevřu najednou 50 souborů je problém s ukládáním vždy se to kousne myslím že to otevře víc souborů najednou a pak neví co zavírat.
také jsem to zkoušel z exelu že bych to spustil a ono by mě to krásně celou složku otevřelo, změnilo a zavřelo
viz
Private Sub CommandButton9_Click()
ChDrive "F"
adresar = "F:\Marek aktualizace"
ChDir adresar
SouboryKtere = Dir("*.*")
ListBox1.Clear
Do While SouboryKtere <> ""
ListBox1.AddItem SouboryKtere
SouboryKtere = Dir
'Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.application")
Set wdDoc = wdApp.Documents.Open _
(Filename:=adresar & "\" & SouboryKtere)
' put your code here for working with Word
' This is Word VBA code, not Excel code
Selection.Find.ClearFormatting
With Selection.Find.Font
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = False
.Subscript = False
End With
With Selection.Find
.Text = "^t"
.Replacement.Text = "^t"
End With
Selection.Find.Execute Replace:=wdReplaceAll
wdDoc.Close savechanges:=True
Set wdDoc = Nothing
wdApp.Quit
Set wdApp = Nothing
Loop
End Sub
ale tady je problém s otevíráním souborů ve wordu děkuji za pomoc