API函数ChangeDisplaySettings返回DISP_CHANGE_BADMODE(-2)问题求助

我使用API函数ChangeDisplaySettings通过UserForms缩放Excel已有5年，如今该函数始终返回-2（即DISP_CHANGE_BADMODE），表示无法设置目标分辨率。核心代码从未修改过，但两台Windows 10电脑上均出现此问题，核心代码如下：

Sub set_Resolution(Width As Long, Height As Long, BpP As Long)

                                        'überprüfen, ob die Grafikkarte den gewünschten Modus unterstützt
    Dim DM          As DEVMODE
    Dim lResult     As Long
                                        ' DEVMODE-Struktur vorbereiten
    With DM
        .dmSize = Len(DM)
        .dmFields = DM_PELSWIDTH _
                    Or DM_PELSHEIGHT _
                    Or DM_BITSPERPEL
        .dmPelsWidth = Width                ' Breite
        .dmPelsHeight = Height              ' Höhe
        .dmBitsPerPel = 32                  ' Farben: 2^dmBitsPerPel
    End With
                                        ' Testen, ob die gewünschte Einstellung unterstützt wird:
    lResult = ChangeDisplaySettings(DM, CDS_TEST)
                                        ' Ausgabe des Ergebnisses:
    Select Case lResult
        Case DISP_CHANGE_SUCCESSFUL
            MsgBox "Bildschirmmodus kann sofort gesetzt werden.", vbInformation
            lResult = ChangeDisplaySettings(DM, 0)
        Case DISP_CHANGE_RESTART
            MsgBox "Bildschirmmodus kann nach Neustart gesetzt werden.", vbInformation
        Case Else
            MsgBox "Bildschirmmodus kann nicht gesetzt werden.", vbCritical
    End Select
End Sub

解决方案 #

• 补全DEVMODE必填字段：Windows 10对DEVMODE结构的完整性要求提升，需添加dmDriverExtra字段赋值，并确保dmBitsPerPel使用传入的BpP参数（原代码硬写32，忽略了参数）。
• 基于现有显示模式初始化：通过EnumDisplaySettings获取当前系统的显示模式作为基础，再修改目标参数，避免结构缺失导致的校验失败。
• 添加刷新率字段：将DM_DISPLAYFREQUENCY加入dmFields，保留当前刷新率，避免因刷新率不匹配触发BADMODE错误。
• 权限与驱动检查：以管理员权限运行Excel，更新显卡驱动至最新版本，旧驱动可能无法兼容Windows 10的显示模式验证逻辑。

修正后的代码示例 #

' 声明API常量与DEVMODE结构
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const DM_BITSPERPEL = &H40000
Private Const DM_DISPLAYFREQUENCY = &H400000
Private Const CDS_TEST = &H4
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1

Private Type DEVMODE
    dmDeviceName(0 To 31) As Byte
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName(0 To 31) As Byte
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type

Private Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, ByVal dwflags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DEVMODE) As Long

Sub set_Resolution(Width As Long, Height As Long, BpP As Long)
    Dim DM As DEVMODE
    Dim lResult As Long
    
    ' 获取当前显示模式，初始化DEVMODE结构
    lResult = EnumDisplaySettings(vbNullString, 0, DM)
    If lResult = 0 Then
        MsgBox "无法获取当前显示模式信息", vbCritical
        Exit Sub
    End If
    
    ' 配置目标显示参数
    With DM
        .dmSize = Len(DM)
        .dmDriverExtra = 0
        .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
        .dmPelsWidth = Width
        .dmPelsHeight = Height
        .dmBitsPerPel = BpP ' 使用传入的色深参数
    End With
    
    ' 测试目标模式是否支持
    lResult = ChangeDisplaySettings(DM, CDS_TEST)
    
    Select Case lResult
        Case DISP_CHANGE_SUCCESSFUL
            MsgBox "Bildschirmmodus kann sofort gesetzt werden.", vbInformation
            lResult = ChangeDisplaySettings(DM, 0)
        Case DISP_CHANGE_RESTART
            MsgBox "Bildschirmmodus kann nach Neustart gesetzt werden.", vbInformation
        Case Else
            MsgBox "Bildschirmmodus kann nicht gesetzt werden. Fehlercode: " & lResult, vbCritical
    End Select
End Sub

内容的提问来源于stack exchange，提问作者drambeldier