' Очистка содержимого
Range("C2:C" & Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
[C2].Resize(Cells(Rows.Count, "A").End(xlUp).Row - 1, 1).FormulaR1C1 = _
"=RC[-2]&CHAR(10)&REPLACE(RC[-1],1,IFERROR(FIND("" ул."",RC[-1]),IFERROR(FIND("" пр-кт"",RC[-1]),IFERROR(FIND("" б-р"",RC[-1]),IFERROR(FIND("" пер"",RC[-1]),IFERROR(FIND("" наб."",RC[-1]),1))))),"""")&CHAR(10)&REPLACE(LEFT(RC[-1],FIND("","",RC[-1])-1),1,7,)&CHAR(10)&LEFT(RC[-1],6)"
' Преобразование формулы в значения
With Range("C2:C" & Cells(Rows.Count, "A").End(xlUp).Row)
.Value = .Value
End With
' Делаем ФИО жирным в столбце C.
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
searchString = ThisWorkbook.Sheets(1).Cells(i, 1).Value ' ФИО из столбца А
'Определяем позицию начала ФИО в ячейке С
Dim startPos As Long
startPos = InStr(1, ThisWorkbook.Sheets(1).Cells(i, 3).Value, searchString)
'Если ФИО обнаружено в ячейке С
If startPos > 0 Then
With ThisWorkbook.Sheets(1).Cells(i, 3).Characters(startPos, Len(searchString)).Font
.Bold = True
End With
End If
Next i
MsgBox "Обработка завершена."
MsgBox ("Это снова я - твой помощник и мы продолжаем" & vbCrLf & "Сейчас Вас система попросит выбрать файл Word, где хранится шаблон наклеек")
' Диалоговое окно для выбора файла шаблона Word
Dim wordFilePath As String
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите файл шаблона Word"
.Filters.Clear
.Filters.Add "Word Documents", "*.doc"
.AllowMultiSelect = False
If .Show = -1 Then
wordFilePath = .SelectedItems(1)
Else
MsgBox "Файл не выбран. Макрос завершен."
Exit Sub
End If
End With
On Error Resume Next
Dim objWrdApp As Object
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then
Set objWrdApp = CreateObject("Word.Application")
End If
On Error GoTo 0 ' Включить стандартную обработку ошибок обратно
objWrdApp.Visible = True
Dim objWrdDoc As Object
Set objWrdDoc = objWrdApp.Documents.Open(wordFilePath)
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
l = l + 1
' Обновление закладок в Word данными из Excel
With objWrdDoc
.Bookmarks("Bookmark_2").Range.Text = Cells(i, 3).Value
.Bookmarks("Bookmark_3").Range.Text = Cells(i + 1, 3).Value
.Bookmarks("Bookmark_4").Range.Text = Cells(i + 2, 3).Value
.Bookmarks("Bookmark_5").Range.Text = Cells(i + 3, 3).Value
.Bookmarks("Bookmark_6").Range.Text = Cells(i + 4, 3).Value
.Bookmarks("Bookmark_7").Range.Text = Cells(i + 5, 3).Value
.Bookmarks("Bookmark_8").Range.Text = Cells(i + 6, 3).Value
.Bookmarks("Bookmark_9").Range.Text = Cells(i + 7, 3).Value
.Bookmarks("Bookmark_10").Range.Text = Cells(i + 8, 3).Value
.Bookmarks("Bookmark_11").Range.Text = Cells(i + 9, 3).Value
.Bookmarks("Bookmark_12").Range.Text = Cells(i + 10, 3).Value
.Bookmarks("Bookmark_13").Range.Text = Cells(i + 11, 3).Value
.Bookmarks("Bookmark_14").Range.Text = Cells(i + 12, 3).Value
.Bookmarks("Bookmark_15").Range.Text = Cells(i + 13, 3).Value
.Bookmarks("Bookmark_16").Range.Text = Cells(i + 14, 3).Value
.Bookmarks("Bookmark_17").Range.Text = Cells(i + 15, 3).Value
End With |
