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

Тема в разделе "Visual Basic", создана пользователем -, 14 дек 2007.

Статус темы:
Закрыта.
  1. Гость

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

    Normann Well-Known Member

    Репутация:
    0
    Регистрация:
    9 авг 2007
    Сообщения:
    168
    Симпатии:
    2
    Если ты хочешь узнать как спрограммировать в офисных приложениях чтото и не знаешь как то выход ооочень прост: записываешь макрос из своих действий призводящих нужный тебе результат, а потом просто открываешь код и смотришь. Элементарно.
     
  3. Гость

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

    Normann Well-Known Member

    Репутация:
    0
    Регистрация:
    9 авг 2007
    Сообщения:
    168
    Симпатии:
    2
    Не кричи, все проще чем кажется, если драйвер принтера поддерживает формат то и "система" будет поддерживать. Если у тебя не отображается какойто формат это значит что для книги выбран не тот принтер. И вообще список на панели настройки параметров страницы не краеугольный камень, что тебе мишает в макросе писать 70 или еще чтото даже если и принтер не тот?
     
  5. Гость

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

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

    Normann Well-Known Member

    Репутация:
    0
    Регистрация:
    9 авг 2007
    Сообщения:
    168
    Симпатии:
    2
    Покажи код или прикрепи всю книгу
     
  7. Гость

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

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


    Код (Text):
    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
    Почему то его тоже не дают отправить
     

    Вложения:

    • __________.doc
      Размер файла:
      505 КБ
      Просмотров:
      64
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей