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 

NOTH Windowsコンピュータ上のSetDisplayAutoRotationPreferences機能がありますので、それがコンピュータ上で動作しない理由はあります。

マクロが実行されているデバイスがタブレットであるかどうかを判断する方法はありますか？または、おそらくDLLのエントリポイントのエラーを避けるために？
コンピュータのOSは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