Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Разделение word на одностраничный pdf с присвоением имен - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Разделение word на одностраничный pdf с присвоением имен
Разделение word на одностраничный pdf с присвоением имен
maximich Дата: Четверг, 16.11.2023, 15:50 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Уважаемые форумчане, здравствуйте!
Помогите допилить макрос.
Суть такая, у меня есть пятистраничный (всегда) word файл.
Я хочу макросом его разделить на одностраничные файлы pdf с жесткой привязкой имен создаваемых pdf файлов. Т.е. Первый файл .pdf создаваемый из первой страницы word файла всегда бы назывался Ромашка.pdf, второй файл .pdf создаваемый из второй страницы word файла всегда бы назывался Кактус.pdf, третий файл .pdf создаваемый из третьей страницы word файла всегда бы назывался Василек.pdf, четвертый файл .pdf создаваемый из четвертый страницы word файла всегда бы назывался Тюльпан.pdf, пятый файл .pdf создаваемый из пятой страницы word файла всегда бы назывался Нарцис.pdf.
Нашел на просторах интернета следующий макрос
[vba]
Код
Sub SaveAsSeparatePDFs()
'UpdatebyExtendoffice20181120
    Dim I As Long
    Dim xDlg As FileDialog
    Dim xFolder As Variant
    Dim xStart, xEnd As Integer
    On Error GoTo lbl
    Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xDlg.Show <> -1 Then Exit Sub
    xFolder = xDlg.SelectedItems(1)
    xStart = CInt(InputBox("Start Page", "KuTools for Word"))
    xEnd = CInt(InputBox("End Page:", "KuTools for Word"))
    If xStart <= xEnd Then
        For I = xStart To xEnd
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                xFolder & "\Page_" & I & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                wdExportFromTo, From:=I, To:=I, Item:=wdExportDocumentContent, _
                IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
                wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=False, UseISO19005_1:=False
        Next
    End If
    Exit Sub
lbl:
    MsgBox "Enter right page number", vbInformation, "KuTools for Word"
End Sub
[/vba]
но не знаю, как в него запихнуть условия, которые я написал выше и как убрать указание номера первой и последний страницы делимого word файла (так как в моем файле всегда и только пять страниц и все их надо разделить.


Заранее спасибо
К сообщению приложен файл: 6640170.jpg (6.0 Kb) · 6891472.jpg (7.5 Kb)
 
Ответить
СообщениеУважаемые форумчане, здравствуйте!
Помогите допилить макрос.
Суть такая, у меня есть пятистраничный (всегда) word файл.
Я хочу макросом его разделить на одностраничные файлы pdf с жесткой привязкой имен создаваемых pdf файлов. Т.е. Первый файл .pdf создаваемый из первой страницы word файла всегда бы назывался Ромашка.pdf, второй файл .pdf создаваемый из второй страницы word файла всегда бы назывался Кактус.pdf, третий файл .pdf создаваемый из третьей страницы word файла всегда бы назывался Василек.pdf, четвертый файл .pdf создаваемый из четвертый страницы word файла всегда бы назывался Тюльпан.pdf, пятый файл .pdf создаваемый из пятой страницы word файла всегда бы назывался Нарцис.pdf.
Нашел на просторах интернета следующий макрос
[vba]
Код
Sub SaveAsSeparatePDFs()
'UpdatebyExtendoffice20181120
    Dim I As Long
    Dim xDlg As FileDialog
    Dim xFolder As Variant
    Dim xStart, xEnd As Integer
    On Error GoTo lbl
    Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xDlg.Show <> -1 Then Exit Sub
    xFolder = xDlg.SelectedItems(1)
    xStart = CInt(InputBox("Start Page", "KuTools for Word"))
    xEnd = CInt(InputBox("End Page:", "KuTools for Word"))
    If xStart <= xEnd Then
        For I = xStart To xEnd
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                xFolder & "\Page_" & I & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                wdExportFromTo, From:=I, To:=I, Item:=wdExportDocumentContent, _
                IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
                wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=False, UseISO19005_1:=False
        Next
    End If
    Exit Sub
lbl:
    MsgBox "Enter right page number", vbInformation, "KuTools for Word"
End Sub
[/vba]
но не знаю, как в него запихнуть условия, которые я написал выше и как убрать указание номера первой и последний страницы делимого word файла (так как в моем файле всегда и только пять страниц и все их надо разделить.


Заранее спасибо

Автор - maximich
Дата добавления - 16.11.2023 в 15:50
bigor Дата: Четверг, 16.11.2023, 17:29 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1110
Репутация: 212 ±
Замечаний: 0% ±

нет
maximich, как то так. Не проверял
[vba]
Код
Sub SaveAsSeparatePDFs()
'UpdatebyExtendoffice20181120
    Dim I As Long
    Dim xDlg As FileDialog
    Dim xFolder As Variant
    Dim xStart, xEnd As Integer
    DIM ARR as variant
    On Error GoTo lbl
    Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xDlg.Show <> -1 Then Exit Sub
    xFolder = xDlg.SelectedItems(1)
    xStart = 1
    xEnd = 5
    ARR = Array("Ромашка", "Кактус","Василёк", "Тюльпан","Нарцисс")

        For I = xStart To xEnd
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                xFolder & "\" & arr(I-1) & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                wdExportFromTo, From:=I, To:=I, Item:=wdExportDocumentContent, _
                IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
                wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=False, UseISO19005_1:=False
        Next
    End If
    Exit Sub
lbl:
   
End Sub
[/vba]


Сообщение отредактировал bigor - Четверг, 16.11.2023, 17:32
 
Ответить
Сообщениеmaximich, как то так. Не проверял
[vba]
Код
Sub SaveAsSeparatePDFs()
'UpdatebyExtendoffice20181120
    Dim I As Long
    Dim xDlg As FileDialog
    Dim xFolder As Variant
    Dim xStart, xEnd As Integer
    DIM ARR as variant
    On Error GoTo lbl
    Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xDlg.Show <> -1 Then Exit Sub
    xFolder = xDlg.SelectedItems(1)
    xStart = 1
    xEnd = 5
    ARR = Array("Ромашка", "Кактус","Василёк", "Тюльпан","Нарцисс")

        For I = xStart To xEnd
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                xFolder & "\" & arr(I-1) & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                wdExportFromTo, From:=I, To:=I, Item:=wdExportDocumentContent, _
                IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
                wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=False, UseISO19005_1:=False
        Next
    End If
    Exit Sub
lbl:
   
End Sub
[/vba]

Автор - bigor
Дата добавления - 16.11.2023 в 17:29
maximich Дата: Четверг, 16.11.2023, 18:16 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
bigor, спасибо за помощь!
Вылетала ошибка, убрал строку
[vba]
Код
End If
[/vba]
и все заработало.
Еще раз спасибо!
 
Ответить
Сообщениеbigor, спасибо за помощь!
Вылетала ошибка, убрал строку
[vba]
Код
End If
[/vba]
и все заработало.
Еще раз спасибо!

Автор - maximich
Дата добавления - 16.11.2023 в 18:16
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Разделение word на одностраничный pdf с присвоением имен
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!