В Powerpoint 2007/2010, запущенном в системе с несколькими мониторами, мы можем выбрать монитор, на котором будет отображаться слайд-шоу, перейдя в «Слайд-шоу» -> «Настроить слайд-шоу» -> «Показать слайд-шоу на» и выбрав нужный монитор. .
Можно ли программно определить эти настройки (например, с помощью VBA)?
Что мне действительно нужно, так это разрешение монитора, на котором показывается слайд-шоу, в пикселях. Как я могу это сделать?
3 ответа
Попробуй это:
With SlideShowWindows(1)
Debug.Print .Height
Debug.Print .Width
End With
Это даст вам результат в очках. На дюйм 72 точки, поэтому:
ResultInPixels = (ResultInPoints * WindowsDPI) / 72
Обычно WindowsDPI равен 96, но на это нельзя полагаться. Вызов API GetSystemMetrics даст вам текущее значение.
Даже если вы уже приняли ответ Стива. Вот несколько полезных фрагментов кода.
Вы можете получить информацию о системном мониторе с помощью такого кода (можно найти здесь ):
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
И сравните результаты с текущими результатами SlideShowWindows(1)
.
Код @JMax от Эдвина Вермеера действительно великолепен. Я уверен, что меня поразят моды для этого, но я сделал диаграмму ниже, чтобы показать, что именно возвращает Sub test()
в коде. Надеюсь, это сэкономит еще n00b за час или два.
Совет: найдите, замените Dubug.Print
на MsgBox
и прогоните код несколько раз с различными настройками монитора, чтобы убедиться, что вы понимаете результаты.
Ниже приведена ставка на нечетное расположение монитора, которая хорошо демонстрирует различные результаты, которые вы получите:
... ну он не позволит мне публиковать фотографии, пока у меня не будет 10 репутации, диаграммы здесь:
«Монитор» возвращается для основного монитора
"Рабочая область" возвращается для основного монитора
«Монитор / рабочая область» возвращается для дополнительного монитора
(в том же альбоме, что и другие 2, нужно 10 репутации для публикации> 2 ссылки ...)
Похожие вопросы
Связанные вопросы
Новые вопросы
vba
Visual Basic для приложений (VBA) - это управляемый событиями объектно-ориентированный язык программирования для написания макросов, используемый для всего пакета Office, а также для других приложений. VBA не эквивалентен VB.NET или VBS; если вы работаете в Visual Studio, используйте [vb.net]. Если ваш вопрос конкретно касается программирования любого приложения MS Office, также используйте соответствующий тег: [excel], [ms-access], [ms-word], [outlook] или [ms-project].