Нестандартные размеры страницы Excel

  • Автор темы -
  • Дата начала
Статус
Закрыто для дальнейших ответов.

Гость
#1
Подскажите, как можно в Excel через макрос задать нестандартные размеры бумаги, напрямую через высоту и ширину.
Макрос, сформированный для Word (там можно напрямую задавать высоту и ширину через paperSize, width, hight ) для Excel не подходит.
Указание через область печати не дает нужного результата, т.к. печатать нужно на нестандартной бумаге, а в данному случае устанавливается формат по умолчанию А4.
Может можно как-то задать этот формат для принтера?
 

Normann

Well-Known Member
09.08.2007
168
2
#2
Если ты хочешь узнать как спрограммировать в офисных приложениях чтото и не знаешь как то выход ооочень прост: записываешь макрос из своих действий призводящих нужный тебе результат, а потом просто открываешь код и смотришь. Элементарно.
 

Гость
#3
Я это прекрасно знаю. Не все так просто как кажестя.
При задании формата страницы система создает код типа: .PaperSize = xlPaperEnvelopeC6, для формата А6 .PaperSize = 70 или .PaperSize = 257 (в зависимости от Офиса видимо, не знаю точно от чего). Некоторые системы вообще не понимают такие записис для формата А6 и печатают как на А4, а значит криво.
А если мне надо нестандартный размер? Или если в списке форматов нет формата КонвертС6, хотя принтер может такой конверт распечатать?
К тому же у меня в Excel вообще нет возможности задать нестандартный формат бумаги, задавая ширину и высоту (в свойствах принтера такая возможность отсутствует).
И что делать, если очень надо?
 

Normann

Well-Known Member
09.08.2007
168
2
#4
Не кричи, все проще чем кажется, если драйвер принтера поддерживает формат то и "система" будет поддерживать. Если у тебя не отображается какойто формат это значит что для книги выбран не тот принтер. И вообще список на панели настройки параметров страницы не краеугольный камень, что тебе мишает в макросе писать 70 или еще чтото даже если и принтер не тот?
 

Гость
#5
Просто хотелось написать универсальную программу, не привязываясь к принтерам и форматам.
Можно как-то узнать, под каким номером или обозначением в Excel хранятся форматы бумаги?
Столкнулась с тем, что макрос формирует автоматически документ с форматом А6, но принтер печатает его как А4. Формат Конверт С6 не поддерживает, но известно, что из специальной программы для печати конвертов такие конверты на этом же принтере печатаются.
Может все таки можно как-то решить эту проблему? :rolleyes:

Кстати, пыталась формировать документы на формате А4 и задавать область печати, но при этом надо, чтобы данные располагались по центру по вертикали и у правого края по горизонтали, но Excel дает выравнивать только по центру или слева.
 

Гость
#7
Высылаю файл со всеми макросами и инструкцией. Это программка для печати конвертов и заданной формы уведомления. Основные проблемы возникают для форматов КонвертС6 и А6.

Почему-то не дает отправить книгу Excel. Высылаю код.


Код:
Sub КонвертС6()


'Определение пути текущего файла
Dim PathFile As String
PathFile = ActiveWorkbook.Path


'Отключение обновления экрана
Application.ScreenUpdating = False

'Вывод формы с сообщением
Dim frmMsg As UserForm1
Set frmMsg = New UserForm1
frmMsg.Show vbModeless
DoEvents




'Объявление переменных
Dim Fam As String, Im As String, Otch As String, Ul As String, Dom As String, Kv As String, Gor As String, Pos As String, Ind As String, Ind2 As String

'Ввод данных для физ.лиц
If ActiveSheet.Name = "Физ.лица" Then

With ActiveWorkSheet

Fam = Cells(ActiveCell.Row, 1).Text
Im = Cells(ActiveCell.Row, 2).Text
Otch = Cells(ActiveCell.Row, 3).Text

'Адрес
Ind = Cells(ActiveCell.Row, 4).Text
Ind2 = "-" & Cells(ActiveCell.Row, 4).Text
Gor = Cells(ActiveCell.Row, 5).Text
Pos = Cells(ActiveCell.Row, 6).Text
Ul = Cells(ActiveCell.Row, 7).Text
Dom = Cells(ActiveCell.Row, 8).Text
Kv = Cells(ActiveCell.Row, 9).Text

End With

'Ввод данных для юридических лиц
Else

With ActiveWorkSheet
'Адрес
Fam = Cells(ActiveCell.Row, 1).Text
Ind = Cells(ActiveCell.Row, 2).Text
Ind2 = "-" & Cells(ActiveCell.Row, 2).Text
Gor = Cells(ActiveCell.Row, 3).Text
Pos = Cells(ActiveCell.Row, 4).Text
Ul = Cells(ActiveCell.Row, 5).Text
Dom = Cells(ActiveCell.Row, 6).Text
Kv = Cells(ActiveCell.Row, 7).Text
End With
End If

'Создание нового файла для конверта
With Application

.SheetsInNewWorkbook = 1
End With

Workbooks.Add
Sheets("Лист1").Select
Sheets("Лист1").Name = "КонвертС6"





'Параметры страницы
With Sheets("КонвертС6").PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.Orientation = xlLandscape
.PaperSize = xlPaperEnvelopeC6
.Zoom = 100
.CenterHorizontally = True
.CenterVertically = True
End With

'Задание ширины столбцов и высоты строк

With Sheets("КонвертС6")
Columns("A:A").ColumnWidth = 8.22
Columns("B:B").ColumnWidth = 8.22
Columns("C:C").ColumnWidth = 8.22
Columns("D:D").ColumnWidth = 8.22
Columns("E:E").ColumnWidth = 5.11
Columns("F:F").ColumnWidth = 11.89
Columns("G:G").ColumnWidth = 23.11

Rows("1:1").RowHeight = 13.2
Rows("2:2").RowHeight = 13.2
Rows("3:3").RowHeight = 13.2
Rows("4:4").RowHeight = 13.2
Rows("5:5").RowHeight = 13.2
Rows("6:6").RowHeight = 13.2
Rows("7:7").RowHeight = 13.2
Rows("8:8").RowHeight = 13.2
Rows("9:9").RowHeight = 13.2
Rows("10:10").RowHeight = 13.2
Rows("11:11").RowHeight = 13.2
Rows("12:12").RowHeight = 13.2

Rows("13:13").RowHeight = 18.6
Rows("14:14").RowHeight = 18.6
Rows("15:15").RowHeight = 18.6
Rows("16:16").RowHeight = 18.6
Rows("17:17").RowHeight = 18.6
Rows("18:18").RowHeight = 18.6

Rows("19:19").RowHeight = 19.2

Rows("20:20").RowHeight = 13.2
Rows("21:21").RowHeight = 13.2

End With


'Вводим фиксированные данные
Range("КонвертС6!E13").FormulaR1C1 = "Кому"
Range("КонвертС6!E15").FormulaR1C1 = "Куда"


'Задаем шрифт


With Range("КонвертС6!E13,КонвертС6!E15").Font
.Name = "Arial"
.Size = 9
.Bold = True
.Italic = True
End With
'Границы и подчеркивание

'Подчеркивание строк получателя
With Range("КонвертС6!F13:G13,КонвертС6!E14:G14,КонвертС6!F15:G15,КонвертС6!E16:G16,КонвертС6!E17:G17,КонвертС6!E18:G18").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With




'Вставка ФИО и адреса получателя


Range("КонвертС6!F13") = Fam & " " & Im
Range("КонвертС6!F14") = Otch


Range("КонвертС6!F15") = "обл.Свердловская,"

If Pos = Empty Then
Range("КонвертС6!F16") = "г." & Gor & ","
Else
Range("КонвертС6!F16") = "г." & Gor & ", пос." & Pos & ","
End If

Range("КонвертС6!F17") = "ул." & Ul & ","

If Kv = Empty Then
Range("КонвертС6!F18") = "д." & Dom
Else
Range("КонвертС6!F18") = "д." & Dom & ", к." & Kv
End If





'Задаем шрифт
With Range("КонвертС6!F13,КонвертС6!F14,КонвертС6!F15,КонвертС6!F16,КонвертС6!F17,КонвертС6!F18").Font
.Name = "Courier New"
.Size = 10
.Bold = False
End With


'Ввод индекса получателя
Range("КонвертС6!E19").FormulaR1C1 = Ind

'Объединение ячеек
Range("КонвертС6!E19:F19").Merge

'Задание 4-х границ ячеек и выравнивание по центру
With Range("КонвертС6!E19:F19").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("КонвертС6!E19:F19").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("КонвертС6!E19:F19").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("КонвертС6!E19:F19").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("КонвертС6!E19:F19").Borders(xlInsideVertical).LineStyle = xlNone


With Range("КонвертС6!E19:F19")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With


With Range("КонвертС6!E19:F19").Font
.Name = "Courier New"
.Size = 14
.Bold = False
End With

'Формирование большого индекса получателя
Range("КонвертС6!A19").FormulaR1C1 = Ind2
Range("КонвертС6!A19:D21").Merge
With Range("КонвертС6!A19:D21").Font
.Name = "ZIPcode"
.Size = 47
.Bold = False
End With
With Range("КонвертС6!A19:D21")
.HorizontalAlignment = xlCenter
End With


'Скрытие столбцов и строк
Columns("H:IV").EntireColumn.Hidden = True
Rows("22:65536").EntireRow.Hidden = True

'Отключение сетки
Sheets("КонвертС6").Select
ActiveWindow.DisplayGridlines = False



'Убираем форму
Unload frmMsg
Set frmMsg = Nothing
'MsgBox "Готово!"


'Запрос о сохранении
Otvet = MsgBox("Сохранить документ?", vbYesNo)
Select Case Otvet

Case vbYes
'Сохранение
Dim FName As String
FName = InputBox("Введите имя файла:")

'ChDir "F:\VisualBasic\Каталог"
ActiveWorkbook.SaveAs Filename:=PathFile & "\Каталог\" & FName, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

'Переход к файлу Конверты

' "Windows("Книга2").Activate


' Гиперссылка Макрос

Windows("Конверты").Activate
Sheets("Каталог").Activate

'Поиск первой пустой ячейки в столбце А
Range("A1").Activate
Do While Not IsEmpty(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
Loop


ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=PathFile & "\Каталог\" & FName & ".xls", _
TextToDisplay:=FName & " Конверт С6"


Case vbNo
End Select


'Предварительный просмотр
' ActiveWindow.SelectedSheets.PrintPreview

End Sub

Для работы макроса еще нужен шрифт
ZIPcode.ttf
Почему то его тоже не дают отправить
 

Вложения

Статус
Закрыто для дальнейших ответов.