如何在组合框中获取可用页面大小列表并更改大小

Question

我正在尝试使用 vba 将组合框中所有可用页面大小的列表作为下拉列表。当用户选择大小时，我需要相应地更改工作表大小。同样在另一个组合中，我需要在选择Combobox中的页面大小时填充该纸张尺寸的宽度和高度。

我试过类似的东西。

Dim i As integer
for i = 1 to 30
activesheet.combobox1.value = Activesheet.PageSetup.Papersize(i)
next i

谢谢

Answer 1

这里有一个基于This link的解决方案

ActiveSheet.ComboBox1.List = GetPaperSizes

GetPaperSizes 是您必须放在标准模块中的以下函数：

Option Explicit

'Written: June 14, 2010
'Author:  Leith Ross
'Summary: Lists the supported paper sizes for the default printer in a message box.

Private Const DC_PAPERNAMES = &H10

Private Declare Function DeviceCapabilities _
  Lib "winspool.drv" _
    Alias "DeviceCapabilitiesA" _
      (ByVal lpDeviceName As String, _
       ByVal lpPort As String, _
       ByVal iIndex As Long, _
       ByRef lpOutput As Any, _
       ByRef lpDevMode As Any) _
    As Long

Private Declare Function StrLen _
  Lib "kernel32.dll" _
    Alias "lstrlenA" _
      (ByVal lpString As String) _
    As Long

Function GetPaperSizes() As Variant

    Dim AllNames As String
    Dim I As Long
    Dim Msg As String
    Dim PD As Variant
    Dim Ret As Long
    Dim papersizes() As Byte
    Dim PaperSize As String

    'Retrieve the number of available paper names
    PD = Split(Application.ActivePrinter, " on ")'<<<== change "on" with its local Language translation from english
    Ret = DeviceCapabilities(PD(0), PD(1), DC_PAPERNAMES, ByVal 0&, ByVal 0&)

    'resize the array
    ReDim papersizes(0 To Ret * 64) As Byte

    'retrieve all the available paper names
    Call DeviceCapabilities(PD(0), PD(1), DC_PAPERNAMES, papersizes(0), ByVal 0&)

    'convert the retrieved byte array to an ANSI string
    AllNames = StrConv(papersizes, vbUnicode)

     'loop through the string and search for the names of the papers
    For I = 1 To Len(AllNames) Step 64
        PaperSize = Mid(AllNames, I, 64)
        PaperSize = Left(PaperSize, StrLen(PaperSize))
        If PaperSize <> vbNullString Then Msg = Msg & PaperSize & vbCrLf
    Next I

    GetPaperSizes = Split(Left(Msg, Len(Msg) - 2), vbCrLf)

End Function