62 / 26 / 0
Регистрация: 05.06.2012
Сообщений: 121
1

Макрос. Черно-белая печать и сохранение только значений листа

29.06.2012, 21:04. Показов 2120. Ответов 2
Метки нет (Все метки)

Книга. Много листов. Листы с разноцветными ячейками. Нужно:
1. При нажатии на кнопку 1, оправить только 1-ый лист на печать с параметром "черно-белая" печать.
2. При нажатии на кнопку 2, открыть окно с предложением о сохранении первого(только первого) листа этой книги c именем файла из ячейки(доустим F4). После того как пользователь выберет куда сохранить и сохранит файл. Он(файл) должен содержать в себе - только первый лист нашей книги... без формул, макросов и различных элементов(т.е. содержать в себе только значения ячеек с сохранением форматирования(ширина столбцов, шрифты и пр.). Иметь, по умолчанию, параметр "черно-белая" печать. И, не очень важно, но желательно, чтобы был защищен паролем от любых изменений, кроме печати.

Т.е. я поработал с книгой, нажал кнопку сохранения. Книга создала в памяти копию себя. Удалила в себе все листы кроме первого. Очистилась от формул, макросов и пр.. Поставила себе параметр "черно-белая" печать. Открыла мне окно с предложением сохранить файл под именем из ячейки F4. Я выбрал путь сохранения и сохранил файл. Кастрированная книга уведомила меня, что сохранилась успешно и закрылась. Изначальная книга осталась без изменений(открытая и покорно ждущая дальнейших манипуляций). А кастрированная после последующих открытий не давала ничего изменять(находясь под действием пароля) и разрешала только печатать себя.

Если не слишком губу раскатал... то пусть код макроса будет содержать пояснения. И в идеале - чтобы, после сохранения, файл еще и в зип архив себя запаковал под тем же именем из ячейки F4.

В файле - шаблон.
Вложения
Тип файла: zip АвтоПротокол.zip (117.9 Кб, 29 просмотров)
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
29.06.2012, 21:04
Ответы с готовыми решениями:

Черно-белая печать без полей
Здравствуйте! На днях столкнулся с такой проблемой. Нужно распечатать черно-белый документ...

Черно-белая печать на мфу hp deskjet ink advantage 2545
Всем привет! Народ, подскажите пожалуйста, как на мфу hp deskjet ink advantage 2545 установить...

Можно ли переделать макрос подстановки значений из ячеек одного листа в шаблон(бланк) другого листа, заменив сам бланк ш
Доброго времени суток! Интересует следующий вопрос, есть печатный шаблон (бланк) на листе в excel,...

Макрос сохранение активного листа книги в отдельный файл
Код сохраняет файл, но с пустым содержанием. Подскажите, в чем может быть проблема? With...

2
62 / 26 / 0
Регистрация: 05.06.2012
Сообщений: 121
01.07.2012, 12:17  [ТС] 2
С первым вроде разобрался.

Visual Basic
1
2
3
4
5
6
7
8
9
Sub Макрос3()
    Application.PrintCommunication = False
       With ActiveSheet.PageSetup
        .BlackAndWhite = True
       End With
    Application.PrintCommunication = True
 ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
End Sub
0
62 / 26 / 0
Регистрация: 05.06.2012
Сообщений: 121
01.07.2012, 20:23  [ТС] 3
Второе.

Нашел как сохранить первый лист очистив его от всего - сохранить в PDF

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Очистить лист()
    Sheets("Лист1").Copy
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
         
    Selection.Copy
    Application.CutCopyMode = False
   
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\asd192\Desktop\" & Range("F4") & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
        OpenAfterPublish:=False
    ActiveWindow.Close
End Sub
Нашел как заархивировать в ZIP-архив.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub CreateBackup()
     ' Ìàêðîñ ñîçäàíèÿ ðåçåðâíîé êîïèè òåêóùåãî ôàéëà
    ' ×òîáû ìàêðîñ îáðàáàòûâàë àêòèâíóþ êíèãó - çàìåíèòå â êîäå
    ' âñå ThisWorkbook íà ActiveWorkbook
    ' Àðõèâàöèÿ ôàéëà îñóùåñòâëÿåòñÿ ñðåäñòâàìè Windows
    
     Const PROJECT_NAME = "Ïðîòîêîëû" ' íàçâàíèå âàøåé ïðîãðàììû (ëþáîé òåêñò)
    On Error Resume Next: ThisWorkbook.Save ' ñîõðàíÿåì êíèãó Excel
    
     ' ôîðìèðóåì ïóòü ê ïàïêå, êóäà áóäåò ïîìîùåíà êîïèÿ ôàéëà (â âèäå àðõèâà)
    BackupsPath = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, PROJECT_NAME & " Backups\")
     MkDir BackupsPath ' ñîçäà¸ì ïàïêó, åñëè òàêîâîé åù¸ íåò
    
     ext$ = Split(ThisWorkbook.Name, ".")(UBound(Split(ThisWorkbook.Name, "."))) ' ðàñøèðåíèå ôàéëà
    ' ôîðìèðóåì ïóòü äëÿ êîïèè ôàéëà Excel
    FileNameXls = BackupsPath & " " & [F4] & " " & Format(Now, "DD-MM-YYYY__HH-NN-SS") & "." & ext$
     ' ôîðìèðóåì ïóòü äëÿ ñîçäàâàåìîãî àðõèâà ZIP
    FileNameZip = BackupsPath & " " & [F4] & " " & Format(Now, "DD-MM-YYYY__HH-NN-SS") & ".zip"
     
     ThisWorkbook.SaveCopyAs FileNameXls ' ñîçäà¸ì êîïèþ êíèãè
    ZIPresult = Zip_File(FileNameXls, FileNameZip, True) ' óïàêîâûâàåì êîïèþ êíèãè â àðõèâ ZIP
    
     Debug.Print "Ðåçóëüòàò àðõèâàöèè: " & IIf(ZIPresult, "âûïîëíåíà óñïåøíî", "îøèáêà")
     Debug.Print "Ñîçäàí àðõèâ: " & Dir(FileNameZip)
End Sub
 
 
Function Zip_File(ByVal FileNameXls, ByVal FileNameZip, _
                   Optional ByVal DeleteSourceFile As Boolean = False) As Boolean
     ' Ôóíêöèÿ îñóùåñòâëÿåò óïàêîâêó ôàéëà FileNameXls â àðõèâ ñ èìåíåì FileNameZip
    ' åñëè DeleteSourceFile = TRUE, èñõîäíûé ôàéë FileNameXls óäàëÿåòñÿ ïî îêîí÷àíèè àðõèâàöèè
    ' Âîçâðàùàåò TRUE, åñëè àðõèâàöèÿ çàâåðøèëîñü óäà÷íî, è FALSE â ïðîòèâíîì ñëó÷àå
    On Error Resume Next: Err.Clear:
     If Len(Dir(FileNameZip)) > 0 Then Kill FileNameZip
     If Len(Dir(FileNameXls)) = 0 Then MsgBox "Ôàéë """ & FileNameXls & """ íå íàéäåí!", _
        vbCritical, "Îøèáêà â ôóíêöèè Zip_File": Exit Function
 
     Open FileNameZip For Output As #1
     Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
     Close #1
     Set oApp = CreateObject("Shell.Application")
     oApp.Namespace(FileNameZip).CopyHere FileNameXls    'êîïèðóåì ôàéë â ñæàòóþ ïàïêó
 
     Do Until oApp.Namespace(FileNameZip).Items.Count = 1    'æä¸ì çàâåðøåíèÿ óïàêîâêè ôàéëà
        Application.Wait (Now + TimeValue("0:00:01"))
     Loop
 
 
 
     If DeleteSourceFile Then Kill FileNameXls    ' óäàëÿåì âðåìåííî ñîçäàííûé ôàéë
    Zip_File = Err = 0    ' âîçâðàùàåì ðåçóëüòàò óïàêîâêè (TRUE, åñëè âñ¸ çàâåðøèëîñü óäà÷íî)
End Function
Не могу понять - как соеденить это? Чтобы архивировался PDF.
Вложения
Тип файла: zip Prot.zip (132.3 Кб, 19 просмотров)
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
01.07.2012, 20:23

Черно-белая картинка
Здравствуйте подскажите пожалуйста как правильно прописать фильтр grayscale для фонового...

Черно-белая картинка
Не везет нам что-то с двд. Подруга купила себе двд плеер, подключила его к телеку, а там...

на С++ Черно-белая графика
Нужно решить на С++ Каждый элемент квадратной матрицы размеренности N x N равен нулю, либо...

Чёрно - белая / цветная галерея
Приветствую. Кто знает как реализовать следующие - есть картинки(исходик цветной) на сайте они...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.