Добрый день, уважаемые!
возникла необходимость сокрытия части ИНН в платежках в Word
т.к. в VBA не силен, прошу помощи в написании макроса.

Исходные данные:
документ Word, в нем текст (платежка). надо найти все вхождения ИНН и заменить последние 4 цифры на "Х"

Пример:

ИНН 40506810000001234 -> ИНН 4050681000000ХХХХ

Интересует сам макрос..
---
попробуйте так:

```1c
    Public Sub Test()
    Dim DocCurr As Document
    Dim RangeCurr As Range
    Dim RangeNext As Range
    Set DocCurr = ActiveDocument
    For Each RangeCurr In DocCurr.Words
    If Trim(RangeCurr.Text) = "ИНН" Then
    Set RangeNext = RangeCurr.Next(wdWord)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    End If
    Next
    End Sub
```
---
вот основное решение которое получилось в итоге

```1c
    Sub HidePersonalData()
    Dim RangeCurr As Range
    Dim RangeNext As Range

    ' убирает символ нераздельного пробела
    With Selection.Find
    .Text = Chr(160)
    .Replacement.Text = " "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
    End With

    'обработка ошибки (возникает при расчете смещения в конце файла)
    On Error GoTo mGoToEnd

    'выборка в коллекции всех вхождений по условиям
    For Each RangeCurr In Selection.Words
    If Trim(RangeCurr.Text) = "ИНН" Then
    Set RangeNext = RangeCurr.Next(wdWord)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    ElseIf Trim(RangeCurr.Text) = "КПП" Then
    Set RangeNext = RangeCurr.Next(wdWord)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    ElseIf Trim(RangeCurr.Text) = "БИК" Then
    Set RangeNext = RangeCurr.Next(wdWord, 2)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    ElseIf Trim(RangeCurr.Text) = "Сч" And Trim(RangeCurr.Next(wdWord, 2)) = "№" Then
    Set RangeNext = RangeCurr.Next(wdWord, 4)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    End If
    Next
    Exit Sub

    mGoToEnd:

    End Sub
```
---
а номер ИНН всегда следует через пробел после текста "ИНН" ?
---
когда через один пробел когда через 2номер ИНН разный всегда, колво пробелов 1 или два
---
пытался получить через Selection.Find
но как перебрать все вхождения и получить места где есть ИНН не понимаю
---
Нет вариантов решения вообще?
---
попробуйте так:

```1c
    Public Sub Test()
    Dim DocCurr As Document
    Dim RangeCurr As Range
    Dim RangeNext As Range
    Set DocCurr = ActiveDocument
    For Each RangeCurr In DocCurr.Words
    If Trim(RangeCurr.Text) = "ИНН" Then
    Set RangeNext = RangeCurr.Next(wdWord)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    End If
    Next
    End Sub
```
---
это уже идея!
но это ко всему документу, а надо к Selection
---
вместо
```1c
    For Each RangeCurr In DocCurr.Words
```

написать

```1c
    For Each RangeCurr In Selection.Words
```
---
разобрался в итоге..
переписал конечно много, но за базу ваше взял. Спасибо
---
вроде с вба всегда всё просто было
нажимаешь записать макрос.
проделываешь манипуляции
остановить запись
смотришь макрос что написал
обобщаешь
---
вот основное решение которое получилось в итоге

```1c
    Sub HidePersonalData()
    Dim RangeCurr As Range
    Dim RangeNext As Range

    ' убирает символ нераздельного пробела
    With Selection.Find
    .Text = Chr(160)
    .Replacement.Text = " "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
    End With

    'обработка ошибки (возникает при расчете смещения в конце файла)
    On Error GoTo mGoToEnd

    'выборка в коллекции всех вхождений по условиям
    For Each RangeCurr In Selection.Words
    If Trim(RangeCurr.Text) = "ИНН" Then
    Set RangeNext = RangeCurr.Next(wdWord)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    ElseIf Trim(RangeCurr.Text) = "КПП" Then
    Set RangeNext = RangeCurr.Next(wdWord)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    ElseIf Trim(RangeCurr.Text) = "БИК" Then
    Set RangeNext = RangeCurr.Next(wdWord, 2)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    ElseIf Trim(RangeCurr.Text) = "Сч" And Trim(RangeCurr.Next(wdWord, 2)) = "№" Then
    Set RangeNext = RangeCurr.Next(wdWord, 4)
    RangeNext.Text = Left(RangeNext.Text, Len(RangeNext.Text) - 4) & "XXXX"
    End If
    Next
    Exit Sub

    mGoToEnd:

    End Sub
```