variare dati in diversi file word

[lorenzo.casali]

Anthony .. senza parole ... alla grande !!. GRAZIE.
come posso far in modo tale che la data nuova sia messa in grassetto ?
inoltre.. visto che parto da 0 anzi -1, come conoscenze/competenze, mi sapresti consigliare un manuale per iniziare a studiare programmazione vba ?
Grazie.

[patel]

Ho anch'io una domanda per Anthony
perché non hai usato il metodo find ?

[Anthony47]

Non ho usato il metodo Find perche' volevo limitare la ricerca agli ultimi 2 paragrafi e in piu' cercare la presenza di "marker" per essere quasi certo che modificavo l'area giusta.
Dovendo pero' formattare adesso dovro' usarlo...
La nuova macro:

Codice: Seleziona tutto

Sub RepData2()
Dim oFso As Object, SubD As String, dPath As String, myFile As String
Dim WordApp As Object, WordDOC As Object, WordContent As Object
Dim OData As String, NwData As String, mK1 As String, mK2 As String
Dim dFound As Boolean, pText As String, pCount As Long
'
OData = "04/04/2016"         '<<< La vecchia data...
NwData = "09/05/2017"        '<<< ...da sostituire con questa nuova
mK1 = " Data:_"              'Markers per identificare con buona certezza la data
mK2 = " Firma RGQ_"
SubD = "Reworked"            '<<< I file "lavorati" saranno spostati in questa sottodirectory
'
MsgBox ("Scegliere la directory da cui prelevare i Doc da aggiornare")
With Application.FileDialog(msoFileDialogFolderPicker)
   .Show
    If .SelectedItems.Count = 0 Then
        MsgBox ("Nessuna voce selezionata, processo abortito")
        Exit Sub
    End If
    dPath = .SelectedItems.Item(1) & "\"
End With
'
Set oFso = CreateObject("Scripting.FileSystemObject")
If Not oFso.FolderExists(dPath & SubD) Then
    oFso.CreateFolder (dPath & SubD)
End If
myFile = Dir(dPath & "*.doc*")
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Do
If myFile = "" Then Exit Do
DoEvents
    Set WordDOC = WordApp.Documents.Open(dPath & myFile)
    pCount = WordDOC.Paragraphs.Count
    dFound = False
    If pCount > 2 Then
        For i = pCount To pCount - 1 Step -1
            pText = WordDOC.Paragraphs(i).Range.Text
            If InStr(1, pText, mK1, vbTextCompare) > 0 And _
              InStr(1, pText, mK1, vbTextCompare) > 0 And _
              InStr(1, pText, OData, vbTextCompare) > 0 Then
                dFound = True
'modifica per formattare >>>:
                With WordDOC.Paragraphs(i).Range.Find
                    .ClearFormatting
                    .Replacement.ClearFormatting
                    .Replacement.Font.Bold = True
                    .Execute findtext:=OData, replacewith:=NwData
                End With
'<<<
                WordDOC.Save
                Exit For
            End If
        Next i
    End If
    WordDOC.Close False
    If dFound Then
        Name dPath & myFile As dPath & SubD & "\" & myFile
        mynext = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(mynext, 1) = myFile
        Cells(mynext, 2) = "Y"
    Else
        mynext = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(mynext, 1) = dPath & myFile
        Cells(mynext, 2) = "NO"
        Cells(mynext, 3) = pCount
    End If
myFile = Dir
Loop
WordApp.Quit
Set WordDOC = Nothing
Set WordApp = Nothing
Set oFso = Nothing
MsgBox ("Completato...")
End Sub

E' evidenziato il blocco che si occupa della sostituzione e formattazione.

Ciao