Макрос для Excel

N

Neoneta

Новый пользователь
Сообщения
31
Реакции
1
Молю о помощи. Очень нужен макрос для обработки около 300 файлов. Создан файл с ссылками на нужные документы. Там же возле ссылок есть новое персональное имя для сохранения каждого файла по ссылке. Как открыть из колонки А файла поочерёдно ссылку на другой документ эксель (Пупкин, Глазкин... итд) . В документе Пупкин открыт нужный лист (март) и сохранить его в пдф формате с именем, которое есть на другом листе файла Пупкин (или оно также есть в файле с ссылками в колонке В ). Сохранить. И после этого перейти к следующей ссылке в колонке А? И так до конца списка.
 
Приветствую!

Сокращенный минимальный пример исходного файла и того, что должно в итоге получиться, приложите в архиве.
 
Добрый день. Для примера создан архив во вложении. Не знаю сработают ли ссылки.
 

Вложения

  • пример.rar
    39.8 KB · Просмотры: 3
Должно получится из файла-
211222343 Шарко В.Л. от 19-02-2022.xlsx
новый файл формата пдф с именем
211222343
в котором отражен только лист - 03
 
У вас документ с секретиком. Лист "03" даже через меню "Сохранить как..." сохраняется в формат PDF в виде пустого листа.
Первый раз такое вижу, направил вопрос коллегам.

Вы такую операцию проделывали? У вас нормально сохраняется?
 
Кхм, вот оно что, я уже волосы начал рвать от негодования.

Вот макрос. В связи с тем, что тз отличается от примера, колонки могут не совпадать. Поправите сами в константах.

VB.NET / VBA: 
Option Explicit

Const SHEET_NAME As String = "03"
Const PATH_SOURCE_COLUMN As String = "A"
Const SAVE_NAME_COLUMN As String = "C"

Public Sub ExportSheets_AsPDF()
    On Error Resume Next
    Dim WB As Workbook, WS As Worksheet
    Dim strPath As String
    Dim iRow As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    For iRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        strPath = Cells(iRow, PATH_SOURCE_COLUMN)
        If IsPath(strPath) Then
            Set WB = Workbooks.Open(strPath, False, True)
            If Not (WB Is Nothing) Then
                WB.Windows(1).Visible = False
                Set WS = WB.Worksheets(SHEET_NAME)
                WS.PageSetup.PrintArea = ""
                WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\" & Cells(iRow, SAVE_NAME_COLUMN) & ".pdf"
                WB.Windows(1).Visible = True
                WB.Close False
            End If
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Private Function IsPath(str As String) As Boolean
    IsPath = InStr(str, ":\") <> 0
End Function
 
Последнее редактирование:
А как сохранить чтобы учитывать разметку для печати? В конце периода добавляю доп информацию и соответственно хочу ее тоже так сохранять, но с 16 рядка?
 
Удалить
Код: 
WS.PageSetup.PrintArea = ""
и будет сохранять согласно вашей изначальной разметке.
 
Супер, просто мегасупер. Вам очень благодарна. Думаю мои сотрудники будут тоже в восторге от вас и вашего макроса!
 
Последнее редактирование:
Добрый день, а как бы с приведёнными выше файлами и списком ссылок на эти файлы (реестр) запустить повторяющийся макрос?
Мне нужно открыть ссылку на файл из реестра и запустить свой макрос (Sub замена), закрыть этот файл, после чего вернутся в файл реестра с ссылками и открыть следующий файл по ссылке ниже. Мой макрос примитивен-меняет значение ячейки с одного на другое.
 
Neoneta написал(а):
свой макрос (Sub замена)
Нажмите для раскрытия...
а в какой книге он находится, в той что вы открываете?

И если он везде одинаковый, может проще его просто дописать к текущему коду?
 
Макрос сохранен в личной книге макросов, лучше отдельно, мне там на подпись писать то одну фамилию то затем другую - ( у меня их 2шт), я просто буду потом менять название нужного макроса
 
Вот какие действия делаю если их записать макросом:

VB.NET / VBA: 
Sub ee()
' ггггг
    Range("J16").Select
    Workbooks.Open Filename:= _
        "путь к файлу/ccылка1.xlsx"
    ActiveWindow.Visible = False
    Windows("файл по ссылке1.xlsx -вылазит предупреждение на что я соглашаюсь").Visible = True
    Application.Run "PERSONAL.XLSB!Фамилия1
    ActiveWindow.Close
    Range("J17").Select
    Workbooks.Open Filename:= _
                "путь к файлу/ccылка2.xlsx"
    ActiveWindow.Visible = False
    Windows("файл по ссылке2.xlsx -вылазит предупреждение на что я соглашаюсь").Visible = True
    Application.Run "PERSONAL.XLSB!Фамилия1
    ActiveWindow.Close
    Range("J18").Select
 и так мне надо почти 300 ссылок
End Sub
 
Последнее редактирование модератором:
Нет гарантий, что это будет работать, но попробуйте (предварительно сделав резервную копию всех документов):

VB.NET / VBA: 
Option Explicit

Const SHEET_NAME As String = "03"
Const PATH_SOURCE_COLUMN As String = "A"
Const SAVE_NAME_COLUMN As String = "C"

Public Sub ExportSheets_AsPDF()
    On Error Resume Next
    Dim WB As Workbook, WS As Worksheet
    Dim strPath As String
    Dim iRow As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    For iRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        strPath = Cells(iRow, PATH_SOURCE_COLUMN)
        If IsPath(strPath) Then
            Set WB = Workbooks.Open(strPath, True, False)
            If Not (WB Is Nothing) Then
                Set WS = WB.Worksheets(SHEET_NAME)
                Application.Run "PERSONAL.XLSB!Фамилия1"
                WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\" & Cells(iRow, SAVE_NAME_COLUMN) & ".pdf"
                WB.Close False
            End If
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Private Function IsPath(str As String) As Boolean
    IsPath = InStr(str, ":\") <> 0
End Function
 
Назад
Сверху Снизу