АВТОЗАПОЛНЕНИЕ WORD'а из EXCEL'я

Описание

Полезные команды:


Private Sub CommandButton1_Click()
diapason.Hide
'Loading.Show

start_save = CInt(TextBox1.Value)
stop_save = CInt(TextBox2.Value)

If start_save = 0 Or stop_save = 0 Then
MsgBox "Вы не ввели начальное значение.", vbCritical
Exit Sub
ElseIf stop_save = 0 Then
MsgBox "Вы не вели конечное значение. Формируем письма до последнего возможного значения.", vbInformationв
stop_save = ActiveDocument.MailMerge.DataSource.RecordCount
End If

'count = start_save - stop_save
'unpading_c = 300 / count
End Sub

'Диапазон формирования писем (начало, конец)
Public start_save As Integer, stop_save As Integer

Sub SaveAsFileName()
Dim FileName As String
Dim iPath As String ':: Директория текущего файла
Dim name As String
Dim name_of_main_dir As String ':: Название папки
Dim new_book_name As String ':: Название новой книги

Application.ScreenUpdating = False

':: Запрашиваем название папки
name = InputBox("Как назвать папку для сохранения книг EXEL?")
If name = "" Then
MsgBox "Вы не указали название папки", vbCritical, "Ошибка"
Exit Sub
End If

':: Создаём главную папку, где будут храниться файлы
iPath = ActiveDocument.Path
name_of_main_dir = iPath & "\" & name

If Dir(name_of_main_dir, vbDirectory) = "" Then
MkDir name_of_main_dir
Else:
MsgBox "Папка с таким названием уже существует! - " & name, vbCritical, "Ошибка"
Exit Sub
End If

':: Спрашиваем с какого файла начинать создавать WORD файлы
diapason.Show

With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True

For SectionCount = start_save To stop_save
unpading_c = unpading_c + unpading_c
With .DataSource
ActiveDocument.MailMerge.DataSource.ActiveRecord = SectionCount
ActiveDocument.MailMerge.DataSource.FirstRecord = SectionCount
ActiveDocument.MailMerge.DataSource.LastRecord = SectionCount

' replace Filename with the column heading that you want to use - can't have certain symbols in the name
FileName = .DataFields("Filename").Value
End With

If FileName = "" Then
Exit For
End If

'Get path and file name
FullPathAndName = Replace(name_of_main_dir, "/", "-") & Application.PathSeparator & Replace(FileName, "/", "-") & ".docx"

' Merge the document
.Execute Pause:=False

' Save resulting document.
ActiveDocument.SaveAs (FullPathAndName)
ActiveDocument.Close True
Next
End With
Application.ScreenUpdating = True
End Sub