Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Как применить макрос к нескольким книгам одновременно?, Предпечатная обработка файла
 
Всем спасибо, все свободны. Код заработал. Вот итоговый вариант, если вдруг кому понадобится:
Код
Attribute VB_Name = "Module1"
Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        'действия с файлом
        
        
        
        
    Range("A6:G6").Select 'разъеденить
    With Selection        'ячейки
    Selection.UnMerge     '"A6-G6"
    
    End With
    
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$12:$14"  'сквозные строки "12-14"
        .PrintTitleColumns = "$A:$A" 'сквозные столбцы "A-A"
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = _
        "&""Courier New,обычный""&9Продолжение таблицы 4.12" & Chr(10) & "Лист № &P" 'настройка верхнего колонтитула
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&""Courier New,обычный""&8&F" 'настройка нижнего колонтитула
        .LeftMargin = Application.InchesToPoints(0.393700787401575) 'настройка поля (левое)
        .RightMargin = Application.InchesToPoints(0.393700787401575) 'настройка поля (правое)
        .TopMargin = Application.InchesToPoints(1.18110236220472) 'настройка поля (верхнее)
        .BottomMargin = Application.InchesToPoints(0.393700787401575) 'настройка поля (нижнее)
        .HeaderMargin = Application.InchesToPoints(0.78740157480315) 'настройка поля (верхнего колонтитула)
        .FooterMargin = Application.InchesToPoints(0.196850393700787) 'настройка поля (нижнего колонтитула)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape 'ставим ориентацию страницы - АЛЬБОМ
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlOverThenDown
        .BlackAndWhite = False
        .Zoom = 78                 'настраиваем МАСШТАБ страницы
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = True
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = _
        "&""Courier New,обычный""&9Таблица 4.12" & Chr(10) & "На &N листах" 'настройка колонтитула первой страницы
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Range("A31").Select
    ActiveCell.FormulaR1C1 = "Из общей" & Chr(10) & "численности - " & Chr(10) & "население" & Chr(10) & "в возрасте:" 'удаление ошибочных квадратиков
    With ActiveCell.Characters(Start:=1, Length:=45).Font

    Range("L13").Select
    ActiveCell.FormulaR1C1 = "сбережения;" & Chr(10) & "дивиденды; проценты" 'удаление ошибочных квадратиков
    With ActiveCell.Characters(Start:=1, Length:=31).Font

    End With
    Range("N13").Select
    ActiveCell.FormulaR1C1 = _
        "на иждивении" & Chr(10) & "отдельных лиц; помощь других лиц; алименты" 'удаление ошибочных квадратиков
    With ActiveCell.Characters(Start:=1, Length:=55).Font

    End With
    Range("O13").Select
    ActiveCell.FormulaR1C1 = "иной источ-" & Chr(10) & "ник средств к суще-" & Chr(10) & "ствова-" & Chr(10) & "нию" 'удаление ошибочных квадратиков
    With ActiveCell.Characters(Start:=1, Length:=43).Font
    
    Rows("6:6").Select           'удалить
    Selection.Delete Shift:=xlUp 'строку "6"
    
    Range("A14:T38").Select    '9
    With Selection.Font        'шрифт
        .Name = "Courier New"  'в
        .Size = 9              'таблице
      
    Range("A10").Select
    End With
    End With
    End With
        
       sFiles = Dir
    Loop
     Application.ScreenUpdating = True
             
    ActiveWorkbook.Save 'сохраняем документ
    ActiveWindow.Close 'закрываем документ
     
End Sub


 
Как применить макрос к нескольким книгам одновременно?, Предпечатная обработка файла
 
Макрос заработал. Добавил в конец макроса:
Код
  ActiveWorkbook.Save 'сохраняем документ
  ActiveWindow.Close 'закрываем документ
И при сохранение выскакивает вот такое окно:


Как в макросе прописать нажатие клавиши "Продолжить"?
В параметрах Excel (Сохранение) не нашёл этой настройки.
Изменено: stat74 - 03.09.2014 15:52:58
Как применить макрос к нескольким книгам одновременно?, Предпечатная обработка файла
 
Цитата
Максим Зеленский пишет:
вместо 15-й строки первого кода вставляете то, что вы хотите сделать с файлом
Благодарю, буду разбираться.
Как применить макрос к нескольким книгам одновременно?, Предпечатная обработка файла
 
Да, именно что тысячи файлов с одной таблицей в каждом и находятся они в одной папке. Что значит циклом проходим по файлом? Что-то нужно добавить в макрос? Благодарю за помощь.
Изменено: stat74 - 01.09.2014 19:45:34
Как применить макрос к нескольким книгам одновременно?, Предпечатная обработка файла
 
У меня есть тысячи xls-таблиц определённого содержания. Их все нужно распечатать.
Для того что бы распечатать эти таблицы предварительно нужно подготовить их к печати (удалить лишний столбец, заменить строку, проставить колонтитулы, настроить поля, установить масштаб и прочее).
Я сделал 2 макроса с горячими клавишами. Но это всё-равно неудобно. Возможно сделать так, что бы эти 2 макроса автоматически сработали на всех этих
файлах с xls-таблицами?

Прилагаю 2 модуля с макросами (1 макрос на Ctrl-W и 2 макрос на Ctrl+Q),
и 2 таблицы:
- одну которую нужно распечатать, предварительно запустив эти 2 макроса на ней.
04-11_ Уральский ГО_СН_Русские_Оба_Все [ТАК ЕСТЬ].xls
- И как должна выглядеть таблица после срабатывания этих макросов:
04-11_Уральский ГО_СН_Русские_Оба_Все [ТАК ДОЛЖНО БЫТЬ].xls

В идеале хочется, что бы 1 макрос автоматически сработал на всех таблицах, а я потом, нажав правую кнопку мыши на файле и выбрав "Печать", распечатал эти файлы.
Хочется научиться именно ТЕХНОЛОГИИ автоматической предпечатной обработки файлов в excel.
Потому что в следующих таблицах возможно надо будет делать другую предпечатную обработку.

Чем проще это будет - тем лучше.
Изменено: stat74 - 31.08.2014 19:27:33
Страницы: 1
Наверх