vba - 在VBA中确定设备的类型

Question

我想使用 Excel 宏在平板电脑上锁定屏幕方向。它起作用了。
但是当我回到电脑前时，它向我发送了:
“在 user32 中找不到 DLL 入口点 SetDisplayAutoRotationPreferences”。
用于锁定 screenb 方向的代码如下:

Enum ORIENTATION_PREFERENCE
    ORIENTATION_PREFERENCE_NONE = 0
    ORIENTATION_PREFERENCE_LANDSCAPE = 1
    ORIENTATION_PREFERENCE_PORTRAIT = 2
    ORIENTATION_PREFERENCE_LANDSCAPE_FLIPPED = 4
    ORIENTATION_PREFERENCE_PORTRAIT_FLIPPED = 8
End Enum

Private Declare Function SetDisplayAutoRotationPreferences Lib "user32" (ByVal ORIENTATION_PREFERENCE As Long) As Long

Sub RotateToLandscape()
    Dim lngRet As Long
    lngRet = SetDisplayAutoRotationPreference (ORIENTATION_PREFERENCE_LANDSCAPE)
End Sub

它在计算机上不起作用的原因是 Windows 计算机上没有 SetDisplayAutoRotationPreferences 功能。

有什么方法可以确定宏运行的设备是否是平板电脑？或者也许是为了避免 DLL 入口点错误？
计算机的操作系统是 Windows 7，使用 Excel 10'。

Answer 1

我怀疑，解决问题的最快方法是处理错误。

前言是，在下面的示例中，您现在将忽略 SetDisplayAutoRotationPreference() 函数引发的任何潜在错误。完全有可能进行更稳健的处理以满足您的需求。进一步阅读请参阅:http://www.cpearson.com/excel/errorhandling.htm

Sub RotateToLandscape()
    Dim lngRet As Long

On Error Resume Next 'When error occurs skip that line
    lngRet = SetDisplayAutoRotationPreference (ORIENTATION_PREFERENCE_LANDSCAPE)
On Error GoTo 0 'Set default error handling

End Sub

编辑:

在我当前的环境中，以下正确断言我正在使用桌面，但是您可能需要在您的环境中进行测试。

Sub test_()
strComputerType = fGetChassis()
MsgBox "This Computer is a " & strComputerType
End Sub

Function fGetChassis()
    Dim objWMIService, colChassis, objChassis, strChassisType
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colChassis = objWMIService.ExecQuery("Select * from Win32_SystemEnclosure")
    For Each objChassis In colChassis
        For Each strChassisType In objChassis.ChassisTypes
            Select Case strChassisType
                Case 8
                    fGetChassis = "Laptop" '#Portable
                Case 9
                    fGetChassis = "Laptop" '#Laptop
                Case 10
                    fGetChassis = "Laptop" '#Notebook
                Case 11
                    fGetChassis = "Laptop" '#Hand Held
                Case 12
                    fGetChassis = "Laptop" '#Docking Station
                Case 14
                    fGetChassis = "Laptop" '#Sub Notebook
                Case 18
                    fGetChassis = "Laptop" '#Expansion Chassis
                Case 21
                    fGetChassis = "Laptop" '#Peripheral Chassis
                Case Else
                    fGetChassis = "Desktop"
            End Select
        Next
    Next
End Function