Vba 在双监视器系统中,找出在哪个监视器上显示PowerPoint幻灯片
在多显示器系统上运行的Powerpoint 2007/2010中,我们可以通过转到“幻灯片放映”->“设置幻灯片放映”->“显示幻灯片放映”并选择所需的显示器来选择幻灯片放映的显示器 是否可以通过编程方式确定这些设置(例如,使用VBA) 我真正需要的是显示幻灯片的显示器的像素分辨率。 我该怎么做呢?试试这个:Vba 在双监视器系统中,找出在哪个监视器上显示PowerPoint幻灯片,vba,vsto,powerpoint,resolution,multiple-monitors,Vba,Vsto,Powerpoint,Resolution,Multiple Monitors,在多显示器系统上运行的Powerpoint 2007/2010中,我们可以通过转到“幻灯片放映”->“设置幻灯片放映”->“显示幻灯片放映”并选择所需的显示器来选择幻灯片放映的显示器 是否可以通过编程方式确定这些设置(例如,使用VBA) 我真正需要的是显示幻灯片的显示器的像素分辨率。 我该怎么做呢?试试这个: With SlideShowWindows(1) Debug.Print .Height Debug.Print .Width End With 这会给你分数的结果。 每英寸有72个点,
With SlideShowWindows(1)
Debug.Print .Height
Debug.Print .Width
End With
这会给你分数的结果。
每英寸有72个点,因此:
ResultInPixels=(ResultInPoints*WindowsDPI)/72
通常WindowsDPI是96,但你不能依赖它。
对GetSystemMetrics的API调用将为您提供当前值。即使您已经接受了Steve的答案。下面是一些有用的代码片段 您可以使用此类代码获取有关系统监视器的信息(找到): 并将结果与当前的幻灯片窗口(1)结果进行比较。Edwin Vermeer的代码非常棒。我确信我会因此被mods打败,但我制作了下面的图表来精确显示代码返回中的
Sub test()
。希望这将节省另一个n00b一个或两个小时
提示:找到replaceDubug。用MsgBox
打印
,并使用不同的监视器安排对代码进行几次检查,以确保您了解退货情况
下面是一个奇怪的显示器安排,它很好地展示了您将获得的不同回报:
…在我有10个声誉之前,它不会让我发布图片,图表如下:
二次监视器的“监视器/工作区”返回
(在与其他两张专辑相同的专辑中,需要10个声誉才能发布>2个链接…您是否尝试录制宏并查看生成的代码?PPT 2007/2010中不再有宏录制器。空白-很好地填充。谢谢我如何按语法选择在监视器上显示我想要的幻灯片
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