vba 在双显示器系统中，找出在哪个显示器上显示 PowerPoint 幻灯片
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/7233153/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
In a dual-monitor system, finding out on which monitor a PowerPoint slideshow is displayed
提问by Arie Livshin
In Powerpoint 2007/2010 run on a multiple monitor system, we can select the monitor on which the slideshow will be shown by going to "Slide Show"-> "Set up slideShow" -> "Display SlideShow on" and selecting the desired monitor.
在多监视器系统上运行的 Powerpoint 2007/2010 中，我们可以通过转到“幻灯片放映”->“设置幻灯片放映”->“显示幻灯片放映”并选择所需的监视器来选择将显示幻灯片放映的监视器.
Is it possible to programmatically determine these settings (e.g. using VBA)?
是否可以以编程方式确定这些设置（例如使用 VBA）？
What I actually need is the pixel-resolution of the monitor on which the slideshow is shown. How can I do that?
我真正需要的是显示幻灯片的显示器的像素分辨率。我怎样才能做到这一点？
采纳答案by Steve Rindsberg
Try this:
尝试这个：
With SlideShowWindows(1)
Debug.Print .Height
Debug.Print .Width
End With
That'll give you results in points. There are 72 points to the inch, so:
这会给你的结果点。英寸有 72 点，所以：
ResultInPixels = (ResultInPoints * WindowsDPI) / 72
ResultInPixels = (ResultInPoints * WindowsDPI) / 72
Typically WindowsDPI is 96 but you can't rely on that. API calls to GetSystemMetrics will give you the current value.
通常 WindowsDPI 为 96，但您不能依赖它。对 GetSystemMetrics 的 API 调用将为您提供当前值。
回答by JMax
Even if you already accepted Steve's answer. Here are a few useful snippets of code.
即使您已经接受了史蒂夫的回答。下面是一些有用的代码片段。
You can get info about system monitor with this kind of code (found here):
您可以使用这种代码（在此处找到）获取有关系统监视器的信息：
Attribute VB_Name = "MonitorInfo"
Option Explicit
Public Declare Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
Public Declare Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, ByVal dwData As Long) As Boolean
Public Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFOEX) As Boolean
Public Const CCHDEVICENAME = 32
Public Const MONITORINFOF_PRIMARY = &H1
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type MONITORINFOEX
cbSize As Long
rcMonitor As RECT
rcWork As RECT
dwFlags As Long
szDevice As String * CCHDEVICENAME
End Type
Dim MonitorId() As String
Public Sub Test()
Dim i As Integer
Debug.Print "Number of monitors in this system : " & GetMonitorId
Debug.Print
For i = 1 To UBound(MonitorId)
PrintMonitorInfo (MonitorId(i))
Next i
End Sub
Public Function GetMonitorId()
ReDim MonitorId(0)
' Of course dual screen systems are not available on all Win versions.
If FunctionExist("user32.dll", "EnumDisplayMonitors") = True Then
If EnumDisplayMonitors(&H0, ByVal &H0, AddressOf MonitorEnumProc, &H0) = False Then
Failed "EnumDisplayMonitors"
End If
End If
GetMonitorId = UBound(MonitorId)
End Function
Private Sub PrintMonitorInfo(ForMonitorID As String)
Dim MONITORINFOEX As MONITORINFOEX
MONITORINFOEX.cbSize = Len(MONITORINFOEX)
If GetMonitorInfo(CLng(ForMonitorID), MONITORINFOEX) = False Then Failed "GetMonitorInfo"
With MONITORINFOEX
Debug.Print "Monitor info for device number : " & ForMonitorID
Debug.Print "---------------------------------------------------"
Debug.Print "Device Name : " & .szDevice
If .dwFlags And MONITORINFOF_PRIMARY Then Debug.Print "Primary Display = True" Else Debug.Print "Primary Display = False"
With .rcMonitor
Debug.Print "Monitor Left : " & .Left
Debug.Print "Monitor Top : " & .Top
Debug.Print "Monitor Right : " & .Right
Debug.Print "Monitor Bottom : " & .Bottom
End With
With .rcWork
Debug.Print "Work area Left : " & .Left
Debug.Print "Work area Top : " & .Top
Debug.Print "Work area Right : " & .Right
Debug.Print "Work area Bottom : " & .Bottom
End With
End With
Debug.Print
Debug.Print
End Sub
Public Function FunctionExist(ByVal strModule As String, ByVal strFunction As String) As Boolean
Dim hHandle As Long
hHandle = GetModuleHandle(strModule)
If hHandle = &H0 Then
Failed "GetModuleHandle"
hHandle = LoadLibraryEx(strModule, &H0, &H0): If hHandle = &H0 Then Failed "LoadLibrary"
If GetProcAddress(hHandle, strFunction) = &H0 Then
Failed "GetProcAddress"
Else
FunctionExist = True
End If
If FreeLibrary(hHandle) = False Then Failed "FreeLibrary"
Else
If GetProcAddress(hHandle, strFunction) = &H0 Then
Failed "GetProcAddress"
Else
FunctionExist = True
End If
End If
End Function
Public Sub Failed(ByVal strFunction As String)
If errMsg = True Then
If Err.LastDllError = 0 Then
MessageBoxEx &H0, strFunction & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & "Failed", "Error", MB_OK Or MB_ICONWARNING Or MB_SETFOREGROUND, 0
Else
Errors Err.LastDllError, strFunction
End If
End If
End Sub
Public Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, ByRef lprcMonitor As RECT, ByVal dwData As Long) As Boolean
Dim ub As Integer
ub = 0
On Error Resume Next
ub = UBound(MonitorId)
On Error GoTo 0
ReDim Preserve MonitorId(ub + 1)
MonitorId(UBound(MonitorId)) = CStr(hMonitor)
MonitorEnumProc = 1
End Function
And compare the results with the current SlideShowWindows(1)results.
并将结果与当前SlideShowWindows(1)结果进行比较。
回答by dcmorse
The code @JMaxfrom Edwin Vermeer is really great. I'm sure I'll get smashed by the mods for this but I made the below diagram to show exactly what Sub test()in the code returns. Hopefully this will save another n00b an hour or two.
Edwin Vermeer的代码@JMax真的很棒。我敢肯定我会为此被 mods 粉碎，但我制作了下图以准确显示Sub test()代码中返回的内容。希望这将节省另一个 n00b 一两个小时。
Tip: Find-replace Dubug.Printwith MsgBoxand run through the code a few times with different monitor arrangements to make sure you understand the returns.
提示：查找替换Dubug.Print用MsgBox，并通过代码与不同的显示器安排几次运行，以确保您了解的回报。
The below is an odd monitor arrangement bet it demonstrates well the different returns you'll get:
下面是一个奇怪的监视器安排，它很好地展示了您将获得的不同回报：
...well it won't let me post pics until I have 10 reputation, diagrams are here:
...好吧，它不会让我发布图片，直到我有 10 个声望，图表在这里：
"Monitor" returns for Primary monitor
"Work area" returns for Primary monitor
"Monitor/Work area" returns for Secondary monitor
“监视器/工作区”返回辅助监视器
(in the same album as the other 2, need 10 reputation to post >2 links...)
（与其他 2 个在同一个专辑中，需要 10 个声望才能发布 >2 个链接...）
