在 VBA 中确定设备的类型答案

【问题标题】：Determine the type of a device in VBA在 VBA 中确定设备的类型
【发布时间】：2017-09-29 09:57:06
【问题描述】：

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

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'。

【问题讨论】：

标签： vba excel

【解决方案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

【讨论】：

感谢您的回答。不过，我想知道是否有任何方法可以知道用户是使用平板电脑还是计算机。
@Titip1995 我已经编辑了我的答案，并听取了experts-exchange.com/questions/27576518/… 的建议。

【解决方案2】：

在我的搜索中，我还发现了以下链接：https://www.robvanderwoude.com/vbstech_inventory_laptop.php

下面的代码以防超链接失效：

If IsLaptop( "." ) Then
    WScript.Echo "Laptop"
Else
    WScript.Echo "Desktop or server"
End If


Function IsLaptop( myComputer )
' This Function checks if a computer has a battery pack.
' One can assume that a computer with a battery pack is a laptop.
'
' Argument:
' myComputer   [string] name of the computer to check,
'                       or "." for the local computer
' Return value:
' True if a battery is detected, otherwise False
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
    On Error Resume Next
    Set objWMIService = GetObject( "winmgmts://" & myComputer & "/root/cimv2" )
    Set colItems = objWMIService.ExecQuery( "Select * from Win32_Battery" )
    IsLaptop = False
    For Each objItem in colItems
        IsLaptop = True
    Next
    If Err Then Err.Clear
    On Error Goto 0
End Function

【讨论】：