Define device type in VBA

I wanted to block the orientation of the screen on the tablet using the excel macro. It worked. But when I returned to the computer, he sent me:
"I can not find the entry point of the SetDisplayAutoRotationPreferences DLL in user32."
The code used to lock the screen orientation is as follows:

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

The reason it doesn't work on computers is because there is no SetDisplayAutoRotationPreferences function on Windows computers.

Is there a way to determine if the device on which the macro is running is a tablet or not? Or perhaps to avoid a DLL entry point error?
The computer OS is Windows 7 and it uses excel 10 '.

+4
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

Edit:

, , .

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
+2

Source: https://habr.com/ru/post/1686628/


All Articles