Добрый День. Очень сильно нуждаюсь в Вашей помощи. Проблема следующая. Описание В Листе1 есть формуляр, который заполняется с помощью ВПР, ориентируясь на ячейку С14 - искомое значение. В Листе2 находится сама база данных.
Нужно что-бы в столбце А в Листе2 считывались ячейки построчно и записывались в ячейку С14 в Листе1, и после каждого "шага" - прочтения строки происходило сохранение Листа1 в формате PDF, а имя PDF - файла было равно содержимому ячейки С14 в Листе1. Файл должен сохраняться там же где и находится сам файл ексел.
Короткое описание. 1) Считывание строки, запись в ячейку С14 2) Сохранение PDF 3) Следующее считывание ... итд.
Помогите пожалуйста.
Добрый День. Очень сильно нуждаюсь в Вашей помощи. Проблема следующая. Описание В Листе1 есть формуляр, который заполняется с помощью ВПР, ориентируясь на ячейку С14 - искомое значение. В Листе2 находится сама база данных.
Нужно что-бы в столбце А в Листе2 считывались ячейки построчно и записывались в ячейку С14 в Листе1, и после каждого "шага" - прочтения строки происходило сохранение Листа1 в формате PDF, а имя PDF - файла было равно содержимому ячейки С14 в Листе1. Файл должен сохраняться там же где и находится сам файл ексел.
Короткое описание. 1) Считывание строки, запись в ячейку С14 2) Сохранение PDF 3) Следующее считывание ... итд.
Sub Прямоугольник1_Щелчок() Dim rD As Range Dim fName As String Sheets(1).Activate Set rD = Range("C14") iLr = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row For x = 2 To iLr rD.Value = Sheets(2).Cells(x, 1).Value fName = "c:\TEMP_WIN\" & rD.Value & ".pdf" 'вместо c:\TEMP_WIN\ укажите свой путь для сохранения Application.Calculate ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ fName, Quality:=xlQualityStandard _ , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _ :=False Next x End Sub
[/vba]
Добрый день. Макрос сделал на кнопку [vba]
Код
Sub Прямоугольник1_Щелчок() Dim rD As Range Dim fName As String Sheets(1).Activate Set rD = Range("C14") iLr = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row For x = 2 To iLr rD.Value = Sheets(2).Cells(x, 1).Value fName = "c:\TEMP_WIN\" & rD.Value & ".pdf" 'вместо c:\TEMP_WIN\ укажите свой путь для сохранения Application.Calculate ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ fName, Quality:=xlQualityStandard _ , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _ :=False Next x End Sub
если немного изменить, будет сохранять в той же папке, где файл [vba]
Код
Sub Прямоугольник1_Щелчок() Dim rD As Range Dim fName As String Dim pst As String pst = ActiveWorkbook.Path Sheets(1).Activate Set rD = Range("C14") iLr = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row For x = 2 To iLr rD.Value = Sheets(2).Cells(x, 1).Value fName = pst & "\" & rD.Value & ".pdf" Application.Calculate ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ fName, Quality:=xlQualityStandard _ , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _ :=False Next x End Sub
[/vba]
если немного изменить, будет сохранять в той же папке, где файл [vba]
Код
Sub Прямоугольник1_Щелчок() Dim rD As Range Dim fName As String Dim pst As String pst = ActiveWorkbook.Path Sheets(1).Activate Set rD = Range("C14") iLr = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row For x = 2 To iLr rD.Value = Sheets(2).Cells(x, 1).Value fName = pst & "\" & rD.Value & ".pdf" Application.Calculate ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ fName, Quality:=xlQualityStandard _ , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _ :=False Next x End Sub
В моем варианте выполняется это условие: Файл должен сохраняться там же где и находится сам файл ексел. Макрос запускается кнопкой из листа1 из "E14". [vba]
Код
Sub В_PDF()
Dim sh1 As Worksheet, sh2 As Worksheet Dim lr As Long, i As Long
Application.ScreenUpdating = False
Set sh1 = ActiveSheet Set sh2 = Worksheets("Лист2")
For i = 2 To lr sh1.Range("C14").Value = sh2.Cells(i, "A").Value sh1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ ActiveWorkbook.Path & "\" & sh1.Range("C14").Value & ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False Next
Application.ScreenUpdating = True
MsgBox "Готово!", vbInformation
End Sub
[/vba]
В моем варианте выполняется это условие: Файл должен сохраняться там же где и находится сам файл ексел. Макрос запускается кнопкой из листа1 из "E14". [vba]
Код
Sub В_PDF()
Dim sh1 As Worksheet, sh2 As Worksheet Dim lr As Long, i As Long
Application.ScreenUpdating = False
Set sh1 = ActiveSheet Set sh2 = Worksheets("Лист2")