Moderatori: Anthony47, Flash30005
Sub wordrepl()
Dim ObjWord As Object, FullNome As String, myCerca As String, myRepl As String
Dim objDoc As Object, I As Long
'
'Chiedi il file da gestire:
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Word", "*.doc*", 1 '<<< Filtro per estensione
.Show
If .SelectedItems.Count = 0 Then
MsgBox ("Nessuna voce selezionata, procedura annullata")
GoTo ESci
End If
FullNome = .SelectedItems(1) 'Directory e Nome del file selezionato
End With
'
'Aprilo in word:
Set ObjWord = CreateObject("Word.Application")
ObjWord.Visible = True
Set objDoc = ObjWord.Documents.Open(Filename:=FullNome)
'
If ObjWord Is Nothing Then
MsgBox "Applicazione non disponibile", vbExclamation
GoTo ESci
End If
'
'Cerca e sostituisci:
With objDoc.ActiveWindow
.Selection.HomeKey Unit:=6 'wdStory
For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row
myCerca = "Numero scheda: " & Cells(I, 1).Value
myRepl = "Scheda: " & Cells(I, 2) & " " & Cells(I, 3)
.Selection.Find.ClearFormatting
.Selection.Find.Replacement.ClearFormatting
With .Selection.Find
.Wrap = 1
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
.Selection.Find.Execute myCerca, False, , , , , , , , myRepl
Next I
End With
MsgBox ("Completato... " & vbCrLf & "Controllare il file e salvarlo")
'
ESci:
Set ObjWord = Nothing
Set objDoc = Nothing
End Sub
Torna a Applicazioni Office Windows
Inserire dati filtrati da 2 file ad un terzo file Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 14 |
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
sal vare doc in word in PDF editabile Autore: danibi60 |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 17 ospiti