Condividi:        

macro trova e sostituisci per word 2007

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

macro trova e sostituisci per word 2007

Postdi vale2882 » 13/07/16 17:11

Buon pomeriggio, ho bisogno del vostro aiuto. Ho un documwento word in cui ho un testo scritto in verdana e arial narrow.Il testo è scritto in questo modo:
ABC_DEF_GHI_LMN_1234 Descrizione prodotto
HYT_LMN_PLO_OIU_5678 Descrizione prodotto2
HYT_LMN_PLO_OIU_1236 Descrizione prodotto2
e così via.

Vorrei selezionare solo il testo in arial narrow (come il testo scritto precedentemente), e estrarre dal codice alfanumerico solo i numeri(1234,5678,ecc).Dopo averli estratti, vorrei sostituirli con un indice che si incrementa di 10:0010,0020....
ABC_DEF_GHI_LMN_0010 Descrizione prodotto
HYT_LMN_PLO_OIU_0020 Descrizione prodotto2
HYT_LMN_PLO_OIU_0030 Descrizione prodotto2
Aspetto vostre notizie.Grazie per tutto l'aiuto che mi darete.
vale2882
Utente Junior
 
Post: 98
Iscritto il: 29/07/14 18:41

Sponsor
 

Re: macro trova e sostituisci per word 2007

Postdi Anthony47 » 14/07/16 00:15

Prova a pubblicare un file realistico, per capire che automatismo si potrebbe realizzare.

Per le istruzioni su come allegare un file: viewtopic.php?f=26&t=103893&p=605487#p605487

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro trova e sostituisci per word 2007

Postdi vale2882 » 14/07/16 16:22

ABC_DEF_GHIL.FG_NMH_0020 Descrizione prodotto.
ABC_DEF_GHIL.FG_NMH_0040 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0060 Descrizion prodotto:.
ABC_DEF_GHIL.FG_NMH_0080 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0100 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0120 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0145 Descrizion prodotto:.
ABC_DEF_GHIL.FG_NMH_0150 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0160 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0170 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0175 Descrizion prodotto:.
ABC_DEF_GHIL.FG_NMH_0176 Descrizion prodotto:

Questo è il documento che ho.
Come risultato vorrei:
ABC_DEF_GHIL.FG_NMH_0020 Descrizione prodotto.
ABC_DEF_GHIL.FG_NMH_0040 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0060 Descrizion prodotto:.
ABC_DEF_GHIL.FG_NMH_0080 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0100 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0120 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0140 Descrizion prodotto:.
ABC_DEF_GHIL.FG_NMH_0160 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0180 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0190 Descrizion prodotto:
ABC_DEF_GHIL.FG_NMH_0200 Descrizion prodotto:.
ABC_DEF_GHIL.FG_NMH_0210 Descrizion prodotto:
Vi posto questa macro:

Sub Estrazione_Codici()
'
' Estrazione_Codici Macro
'

Dim arr() As String
Dim result As String
Dim a As String
Dim myrange As Range
ReDim Preserve arr(0)

Dim Index As Integer
Index = 20
'cerco tutti i codici
'Selection.Find.ClearFormatting
'Selection.Find.Replacement.ClearFormatting
For i = 0 To UBound(arr) - 1
With Selection.Find
.ClearFormatting


.Style = "Stile_requisiti"

'.Forward = True
'.Wrap = wdFindContinue
'.Format = True
'.MatchCase = False
'.MatchWholeWord = False
'.MatchWildcards = False
'.MatchSoundsLike = False
'.MatchAllWordForms = False


'PROVA
'.Style = "Rientro corpo del testo 2 + Allineato a sinistra Sinistro"


Do While .Execute(Forward:=True, Format:=True)

If .Parent.End = ActiveDocument.Content.End Then
Exit Do
End If

If .Found = True Then
'MsgBox Selection.Text
ReDim Preserve arr(UBound(arr) + 1)

'arr(UBound(arr)) = Replace(Selection.Text, Chr(13), "")
arr(UBound(arr)) = Replace(Selection.Range.Text, Chr(13), "")
arr(UBound(arr)) = Mid(Selection.Range.Text, 1, 20)
If Index < 100 Then
arr(UBound(arr)) = arr(UBound(arr)) + "00" + Trim(Str(Index))
ElseIf Index <= 980 Then
arr(UBound(arr)) = arr(UBound(arr)) + "0" + Trim(Str(Index))
Else
arr(UBound(arr)) = arr(UBound(arr)) + Trim(Str(Index))
End If
Selection.Collapse Direction:=wdCollapseStart
Selection.Range.Text = arr(UBound(arr))

'arr(UBound(arr)) = RepText(arr(UBound(arr)), Str(Index), arr(UBound(arr)))
'arr(UBound(arr)) = RepText(arr(UBound(arr)), Str(Index), a)



Selection.Range.Text = Replace(Selection.Range.Text, Selection.Range.Text, arr(UBound(arr)))
'Set myrange =

'Selection.Range.Text = Replace(Selection.Range.Text, Selection.Range.Text, arr(UBound(arr)))
arr(UBound(arr)) = Replace(arr(UBound(arr)), " ", "")

Index = Index + 20

'.Text = arr(UBound(arr))
'.Replacement.Text = arr(UBound(arr))

'Selection.Range.Text = Mid(Selection.Range.Text, 1, 24)


'Selection.Range.Text = Replace(Selection.Range.Text, " ", "")

End If


Loop

End With
Next i
'Selection.Find.Execute Replace:=wdReplaceAll
'ultimo req
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = Replace(Selection.Text, Chr(13), "")
arr(UBound(arr)) = Replace(arr(UBound(arr)), " ", "")

'formatto la stringa da salvare
'Dim result As String
'Dim MyRange As Range
'Dim pos As Long
'Set MyRange = ActiveDocument.Range
'pos = MyRange.Start
For ii = 0 To UBound(arr) - 1
'With Selection.Find
result = result & arr(ii) & vbCrLf
'.Text = arr(ii)
'.Replacement.Text = result
'.Forward = True
'.Execute Replace:=wdReplaceAll
'End With
Next ii

Questa macro funziona in parte. Sostituisce solo nella prima riga i codici. Potreste aiutarmi?Grazie mille!
vale2882
Utente Junior
 
Post: 98
Iscritto il: 29/07/14 18:41

Re: macro trova e sostituisci per word 2007

Postdi Anthony47 » 14/07/16 23:33

Senza un file di esempio si puo' solo immaginare...
Prova questa macro:
Codice: Seleziona tutto
Sub blkRepl()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=107176
Dim mySplit, myCnt As Long
'
Selection.HomeKey Unit:=wdStory
Do
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    mySplit = Split(Selection.Text & "zc", " ", , vbTextCompare)
    If UBound(mySplit) > 0 Then
        mySplit = Split(mySplit(0), "_", , vbTextCompare)
        If UBound(mySplit) = 4 Then
            myCnt = myCnt + 20
            Selection.Text = Replace(Selection.Text, mySplit(4), Format(myCnt, "0000"), 1, 1, vbTextCompare)
        End If
    End If
    Selection.MoveDown Unit:=wdParagraph, Count:=1
If Selection.End > (ActiveDocument.Content.End - 10) Then Exit Do
Loop
MsgBox "Completato..."
End Sub

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro trova e sostituisci per word 2007

Postdi vale2882 » 15/07/16 18:51

Buonasera Anthony grazie mille per la risposta.vorrei sapere cosa significa zc?poi vorrei introdurre uno spazio tra il codice e la descrizione del prodotto.per selezionare le parti di testo con uno stile specifico come faccio?grazie davvero!!!
vale2882
Utente Junior
 
Post: 98
Iscritto il: 29/07/14 18:41

Re: macro trova e sostituisci per word 2007

Postdi Anthony47 » 19/07/16 01:20

"zc" e' una stringa che serve a evitare errori su "Split" di stringhe nulle.

Lo spazio tra il codice e la descrizione prodotto ci dovrebbe gia' essere, tant'è che lo uso come separatore nella prima Split; se vuoi aggiungerne un altro allora modifica
Selection.Text = Replace(Selection.Text, mySplit(4), Format(myCnt, "0000"), 1, 1, vbTextCompare) in
Codice: Seleziona tutto
Selection.Text = Replace(Selection.Text, mySplit(4), Format(myCnt, "0000") & " ", 1, 1, vbTextCompare)


Non ho capito che cosa intendi per "parti di testo", perche' in un file word e' tutto testo.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro trova e sostituisci per word 2007

Postdi vale2882 » 20/07/16 20:08

Grazie mille Anthony!!!funziona!!!
vale2882
Utente Junior
 
Post: 98
Iscritto il: 29/07/14 18:41


Torna a Applicazioni Office Windows


Topic correlati a "macro trova e sostituisci per word 2007":


Chi c’è in linea

Visitano il forum: Nessuno e 49 ospiti