Макрос для Excel

Neoneta

Пользователь
Сообщения
16
Реакции
0
Я прошу прощения, мне в последнем запросе нет нужды сохранять в ПДФ, просто обработать и сохранить в том же формате и с прежним именем
 

Dragokas

Angry & Scary Developer
Команда форума
Супер-Модератор
Разработчик
Клуб переводчиков
Сообщения
6,780
Реакции
6,234
Тогда

VB.NET / VBA:
WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\" & Cells(iRow, SAVE_NAME_COLUMN) & ".pdf"
WB.Close False

замените на:

VB.NET / VBA:
WB.Close True
 

Neoneta

Пользователь
Сообщения
16
Реакции
0
Не реагирует вовсе макрос, вот мой который я открываю.

VB.NET / VBA:
Sub aНаВелорапко()
'
' НаВелорапко Макрос
   'снять защиту
    Sheets("дано").Select
    ActiveSheet.Unprotect "qqq"
    Range("B20").Select
    ActiveSheet.Unprotect
    ActiveCell.FormulaR1C1 = ""
    Range("B21").Select
    ActiveCell.FormulaR1C1 = "Батуева М.О."
    Range("B20").Select
    ActiveCell.FormulaR1C1 = "Велорапко О.М."
    'вернуть защиту
    Sheets("дані договору").Select
    ActiveSheet.Protect "qqq"
    'просмотр
    Sheets("04").Activate
    ActiveSheet.Range("F120").Select
    ActiveWorkbook.Save
End Sub

Предупреждение
Пожалуйста, соблюдайте правила форума! Для форматирования кода, обрамляйте его в теги CODE! Подробнее по ссылке.
 
Последнее редактирование модератором:

Dragokas

Angry & Scary Developer
Команда форума
Супер-Модератор
Разработчик
Клуб переводчиков
Сообщения
6,780
Реакции
6,234
Навскидку, макрос как-то грязно записан.
Снимается защита с одного листа ("дано"), а ставится защита уже на совершенно другой лист ("дані договору").
Активируются лишние листы и ячейки, которые не факт, что нужны.
Вообщем, я оставил как есть, если что поправите сами.

VB.NET / VBA:
Option Explicit

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

Public Sub ExportSheets_AsPDF()
    On Error Resume Next
    Dim oBook 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 InStr(strPath, ":\") <> 0 Then 'IsPath
            Set oBook = Workbooks.Open(strPath, True, False)
            If Not (oBook Is Nothing) Then
                ReplaceSurname oBook
                oBook.Close True
            End If
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub ReplaceSurname(oBook As Workbook)
    Dim WS As Worksheet
    Set WS = oBook.Sheets("дано")
    'снять защиту
    WS.Unprotect "qqq"
    WS.Unprotect
    WS.Range("B21").FormulaR1C1 = "Батуева М.О."
    WS.Range("B20").FormulaR1C1 = "Велорапко О.М."
    'вернуть защиту
    oBook.Sheets("дані договору").Protect "qqq"
    'просмотр
    oBook.Sheets("04").Activate
End Sub
 
Последнее редактирование:

Neoneta

Пользователь
Сообщения
16
Реакции
0
Да, то я уже вручную правила (не доправила макрос), вам выслала один пример на основе старой таблици а макрос уже на основе новой. На самом деле там совпадают имена листов. Но не пошел макрос. Ругается.
 

Вложения

  • 1.JPG
    1.JPG
    28.1 KB · Просмотры: 4

Neoneta

Пользователь
Сообщения
16
Реакции
0
Спасибо за помощь, не пойму в чем баг, но макрос не идет-просто после запуска ничего не открывает, изменений не происходит в файлах. Я думаю что остановимся на этом. Мне вы и так очень помогли.
 
Сверху Снизу