Макрос который задает имя по умолчанию при сохранении вордовского документа - VB
Формулировка задачи:
Добрый день!!!!!
Есть такая проблема........
В екселевской таблице ведется реестр постановлений.
При помощи слияния на основании информации, внесенной в ексель, в ворде формируются распоряжения.
Распоряжение идет на 1 л. После завершения слияния пользователю приходится сохранять каждое распоряжение. Имя вордовского документа вносится вручную (имя документа совпадает с переменным полем MERGEFIELD (например "ФИО").
Вопрос:
Как с помощью макроса сделать так, чтобы имя по умолчанию при сохранении бралось из переменного поля???????
Есть макрос который сохраняет лист в новом документе и имя по умолчанию Письмо 1, Письмо 2 и т.д.:
Sub SaveEachPageToFile()
Dim oRng As Range, oMainDoc As Document, oNewDoc As Document, sFileName$, iPage%
Application.ScreenUpdating = False
Set oMainDoc = ActiveDocument
Set oRng = oMainDoc.Range
Do While iPage <= oMainDoc.ComputeStatistics(2) 'wdStatisticPages
iPage = iPage + 1
If iPage < oMainDoc.ComputeStatistics(2) Then
oRng.SetRange oRng.Start, oRng.GoToNext(1).Start ' wdGoToPage
Else
oRng.SetRange oRng.Start, oMainDoc.Range.End
End If
oRng.Copy
Set oNewDoc = Documents.Add
oNewDoc.Range.PasteAndFormat 16 'wdFormatOriginalFormatting
sFileName = "Страница " & iPage & " документа «" & Mid(oMainDoc.Name, 1, InStrRev(oMainDoc.Name, ".") - 1) & "»"
oNewDoc.SaveAs oMainDoc.Path & Application.PathSeparator & sFileName & ".doc", AddToRecentFiles:=False, FileFormat:=wdFormatDocument97
oNewDoc.Close True
Set oRng = oRng.GoToNext(1) 'wdGoToPage
Loop
Application.ScreenUpdating = True
MsgBox "Сохранено в файлы " & iPage & " страниц." & vbCr & _
"Папка сохранения: " & oMainDoc.Path & Application.PathSeparator, vbOKOnly + vbInformation, "Документы сохранены"
End Sub
oNewDoc.Content.Delete
oRng.Copy
oNewDoc.Content.Paste
sFileName = "Страница " & iPage & " документа (" & Mid(oMainDoc.Name, 1, InStrRev(oMainDoc.Name, ".") - 1) & ")"
oNewDoc.SaveAs oMainDoc.Path & Application.PathSeparator & sFileName & ".doc", AddToRecentFiles:=False ', FileFormat:=wdFormatDocument97
Loop While iPage < cntp
Set oRng = Nothing
tmu = timeGetTime() - tm
oNewDoc.Close wdDoNotSaveChanges
Set oNewDoc = Nothing
Application.ScreenUpdating = True
tm = timeGetTime() - tm
timeEndPeriod 1
Debug.Print "Модифицированный = " & CStr(tm / 1000) & "(" & CStr(tmu / 1000) & ")"
MsgBox "Сохранено в файлы " & iPage & " страниц." & vbCr & _
"Папка сохранения: " & oMainDoc.Path & Application.PathSeparator, vbOKOnly + vbInformation, "Документы сохранены"
Set oMainDoc = Nothing
End Sub
Есть такая проблема........
В екселевской таблице ведется реестр постановлений.
При помощи слияния на основании информации, внесенной в ексель, в ворде формируются распоряжения.
Распоряжение идет на 1 л. После завершения слияния пользователю приходится сохранять каждое распоряжение. Имя вордовского документа вносится вручную (имя документа совпадает с переменным полем MERGEFIELD (например "ФИО").
Вопрос:
Как с помощью макроса сделать так, чтобы имя по умолчанию при сохранении бралось из переменного поля???????
Есть макрос который сохраняет лист в новом документе и имя по умолчанию Письмо 1, Письмо 2 и т.д.:
Sub SaveEachPageToFile()
Dim oRng As Range, oMainDoc As Document, oNewDoc As Document, sFileName$, iPage%
Application.ScreenUpdating = False
Set oMainDoc = ActiveDocument
Set oRng = oMainDoc.Range
Do While iPage <= oMainDoc.ComputeStatistics(2) 'wdStatisticPages
iPage = iPage + 1
If iPage < oMainDoc.ComputeStatistics(2) Then
oRng.SetRange oRng.Start, oRng.GoToNext(1).Start ' wdGoToPage
Else
oRng.SetRange oRng.Start, oMainDoc.Range.End
End If
oRng.Copy
Set oNewDoc = Documents.Add
oNewDoc.Range.PasteAndFormat 16 'wdFormatOriginalFormatting
sFileName = "Страница " & iPage & " документа «" & Mid(oMainDoc.Name, 1, InStrRev(oMainDoc.Name, ".") - 1) & "»"
oNewDoc.SaveAs oMainDoc.Path & Application.PathSeparator & sFileName & ".doc", AddToRecentFiles:=False, FileFormat:=wdFormatDocument97
oNewDoc.Close True
Set oRng = oRng.GoToNext(1) 'wdGoToPage
Loop
Application.ScreenUpdating = True
MsgBox "Сохранено в файлы " & iPage & " страниц." & vbCr & _
"Папка сохранения: " & oMainDoc.Path & Application.PathSeparator, vbOKOnly + vbInformation, "Документы сохранены"
End Sub
oNewDoc.Content.Delete
oRng.Copy
oNewDoc.Content.Paste
sFileName = "Страница " & iPage & " документа (" & Mid(oMainDoc.Name, 1, InStrRev(oMainDoc.Name, ".") - 1) & ")"
oNewDoc.SaveAs oMainDoc.Path & Application.PathSeparator & sFileName & ".doc", AddToRecentFiles:=False ', FileFormat:=wdFormatDocument97
Loop While iPage < cntp
Set oRng = Nothing
tmu = timeGetTime() - tm
oNewDoc.Close wdDoNotSaveChanges
Set oNewDoc = Nothing
Application.ScreenUpdating = True
tm = timeGetTime() - tm
timeEndPeriod 1
Debug.Print "Модифицированный = " & CStr(tm / 1000) & "(" & CStr(tmu / 1000) & ")"
MsgBox "Сохранено в файлы " & iPage & " страниц." & vbCr & _
"Папка сохранения: " & oMainDoc.Path & Application.PathSeparator, vbOKOnly + vbInformation, "Документы сохранены"
Set oMainDoc = Nothing
End Sub
Решение задачи: «Макрос который задает имя по умолчанию при сохранении вордовского документа»
textual
Листинг программы
<font color="blue">Sub</font> SaveEachPageToFile()
<font color="blue">Dim</font> oRng <font color="blue">As</font> Range, oMainDoc <font color="blue">As</font> Document, oNewDoc <font color="blue">As</font> Document, sFileName$, iPage%
Application.ScreenUpdating = False
<font color="blue">Set</font> oMainDoc = ActiveDocument
<font color="blue">Set</font> oRng = oMainDoc.Range
<font color="blue">Do</font> <font color="blue">While</font> iPage <= oMainDoc.ComputeStatistics(<font color="darkblue"><b>2</b></font>) <font color="00AA00">'wdStatisticPages</font>
iPage = iPage + <font color="darkblue"><b>1</b></font>
<font color="blue">If</font> iPage < oMainDoc.ComputeStatistics(<font color="darkblue"><b>2</b></font>) <font color="blue">Then</font>
oRng.SetRange oRng.Start, oRng.GoToNext(<font color="darkblue"><b>1</b></font>).Start <font color="00AA00">'wdGoToPage</font>
<font color="blue">Else</font>
oRng.SetRange oRng.Start, oMainDoc.Range.<font color="blue">End</font>
<font color="blue">End</font> <font color="blue">If</font>
oRng.Copy
<font color="blue">Set</font> oNewDoc = Documents.Add
oNewDoc.Range.PasteAndFormat <font color="darkblue"><b>16</b></font> <font color="00AA00">'wdFormatOriginalFormatting</font>
sFileName = <font color="teal">"Страница "</font> & iPage & <font color="teal">" документа «"</font> & <font color="blue">Mid</font>(oMainDoc.<font color="blue">Name</font>, <font color="darkblue"><b>1</b></font>, InStrRev(oMainDoc.<font color="blue">Name</font>, <font color="teal">"."</font>) - <font color="darkblue"><b>1</b></font>) & <font color="teal">"»"</font>
oNewDoc.SaveAs oMainDoc.Path & Application.PathSeparator & sFileName & <font color="teal">".doc"</font>, AddToRecentFiles:=False, FileFormat:=wdFormatDocument97
oNewDoc.<font color="blue">Close</font> True
<font color="blue">Set</font> oRng = oRng.GoToNext(<font color="darkblue"><b>1</b></font>) <font color="00AA00">'wdGoToPage</font>
<font color="blue">Loop</font>
Application.ScreenUpdating = True
MsgBox <font color="teal">"Сохранено в файлы "</font> & iPage & <font color="teal">" страниц."</font> & vbCr & _
<font color="teal">"Папка сохранения: "</font> & oMainDoc.Path & Application.PathSeparator, vbOKOnly + vbInformation, <font color="teal">"Документы сохранены"</font>
<font color="blue">End</font> <font color="blue">Sub</font>
oNewDoc.Content.Delete
oRng.Copy
oNewDoc.Content.Paste
sFileName = <font color="teal">"Страница "</font> & iPage & <font color="teal">" документа ("</font> & <font color="blue">Mid</font>(oMainDoc.<font color="blue">Name</font>, <font color="darkblue"><b>1</b></font>, InStrRev(oMainDoc.<font color="blue">Name</font>, <font color="teal">"."</font>) - <font color="darkblue"><b>1</b></font>) & <font color="teal">")"</font>
oNewDoc.SaveAs oMainDoc.Path & Application.PathSeparator & sFileName & <font color="teal">".doc"</font>, AddToRecentFiles:=False <font color="00AA00">', FileFormat:=wdFormatDocument97</font>
<font color="blue">Loop</font> <font color="blue">While</font> iPage < cntp
<font color="blue">Set</font> oRng = <font color="blue">Nothing</font>
tmu = timeGetTime() - tm
oNewDoc.<font color="blue">Close</font> wdDoNotSaveChanges
<font color="blue">Set</font> oNewDoc = <font color="blue">Nothing</font>
Application.ScreenUpdating = True
tm = timeGetTime() - tm
timeEndPeriod <font color="darkblue"><b>1</b></font>
Debug.<font color="blue">Print</font> <font color="teal">"Модифицированный = "</font> & CStr(tm / <font color="darkblue"><b>1000</b></font>) & <font color="teal">"("</font> & CStr(tmu / <font color="darkblue"><b>1000</b></font>) & <font color="teal">")"</font>
MsgBox <font color="teal">"Сохранено в файлы "</font> & iPage & <font color="teal">" страниц."</font> & vbCr & _
<font color="teal">"Папка сохранения: "</font> & oMainDoc.Path & Application.PathSeparator, vbOKOnly + vbInformation, <font color="teal">"Документы сохранены"</font>
<font color="blue">Set</font> oMainDoc = <font color="blue">Nothing</font>
<font color="blue">End</font> <font color="blue">Sub</font>
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д