di 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!