Option Explicit
Dim WshShell
Dim oExcel, oBook, oModule
Dim strRegKey, strCode
Set oExcel = CreateObject("Excel.Application")
set WshShell = CreateObject("wscript.Shell")
strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
strRegKey = Replace(strRegKey, "$", oExcel.Version)
WshShell.RegWrite strRegKey, 1, "REG_DWORD"
Set oBook = oExcel.Workbooks.Add
Set oModule = obook.VBProject.VBComponents.Add(1)
strCode = _
"Declare Function GetDesktopWindow Lib ""user32"" Alias ""GetDesktopWindow"" () As Long" & vbCr & _
"Declare Function GetWindow Lib ""user32"" Alias ""GetWindow"" (ByVal hwnd As Long, ByVal wCmd As Long) As Long" & vbCr & _
"Declare Function GetParent Lib ""user32"" Alias ""GetParent"" (ByVal hwnd As Long) As Long" & vbCr & _
"Declare Function GetWindowText Lib ""user32"" Alias ""GetWindowTextA"" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long" & vbCr & _
"Declare Function SetWindowLong Lib ""user32"" Alias ""SetWindowLongA"" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long" & vbCr & _
"Declare Function SetWindowText Lib ""user32"" Alias ""SetWindowTextW"" (ByVal hwnd As Long, ByVal lpString As String) As Long" & vbCr & _
"Declare Function EnumDisplaySettings Lib ""user32"" Alias ""EnumDisplaySettingsA"" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As DEVMODE) As Boolean" & vbCr & _
"Declare Function ChangeDisplaySettings Lib ""user32"" Alias ""ChangeDisplaySettingsA"" (lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long" & vbCr & _
"Type DEVMODE: dmDeviceName As String * 32: 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 As String * 32: dmUnusedPadding As Integer: dmBitsPerPel As Integer: dmPelsWidth As Long: dmPelsHeight As Long: dmDisplayFlags As Long: dmDisplayFrequency As Long: End Type" & vbCr & _
"Sub API_ChangeDisplaySettings (Width As Integer, Height As Integer): Dim data As DEVMODE: EnumDisplaySettings 0, -1, data: data.dmPelsWidth = Width: data.dmPelsHeight = Height: ChangeDisplaySettings data, 1: End Sub" & vbCr & _
"Function API_GetWindowText (hwnd) As String : Dim text As String : text=space(窗口标题长度) : GetWindowText hwnd,text,窗口标题长度+1 : API_GetWindowText=text : End Function"
oModule.CodeModule.AddFromString strCode Dim gamehwnd
gamehwnd = FindWindow()
if gamehwnd<>-1 then
oExcel.Run "SetWindowLong",gamehwnd,-16,113901568
oExcel.Run "SetWindowText",gamehwnd,"\Code By xfgryujk/"'*********要修改的窗口标题,可以去掉这句
oExcel.Run "API_ChangeDisplaySettings",1024,768'*********分辨率,根据需要自己改
Else
MsgBox "未找到窗口!",16,"通用窗口化"
End if oExcel.DisplayAlerts = False
oBook.Close
oExcel.Quit Function FindWindow()
Dim res,hwnd
res=-1
hwnd=oExcel.Run("GetWindow",oExcel.Run("GetDesktopWindow"),5)
Do While hwnd<>0
hwnd=oExcel.Run("GetWindow",hwnd,2)
if oExcel.Run("API_GetWindowText",hwnd)="窗口标题" then'*********要窗口化的窗口标题
res=hwnd
Exit do
End if
Loop
findwindow=res
End Function
我们不能把不认同和不忠诚混为一谈。——爱德华·R·默罗
Dim WshShell
Dim oExcel, oBook, oModule
Dim strRegKey, strCode
Set oExcel = CreateObject("Excel.Application")
set WshShell = CreateObject("wscript.Shell")
strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
strRegKey = Replace(strRegKey, "$", oExcel.Version)
WshShell.RegWrite strRegKey, 1, "REG_DWORD"
Set oBook = oExcel.Workbooks.Add
Set oModule = obook.VBProject.VBComponents.Add(1)
strCode = _
"Declare Function GetDesktopWindow Lib ""user32"" Alias ""GetDesktopWindow"" () As Long" & vbCr & _
"Declare Function GetWindow Lib ""user32"" Alias ""GetWindow"" (ByVal hwnd As Long, ByVal wCmd As Long) As Long" & vbCr & _
"Declare Function GetParent Lib ""user32"" Alias ""GetParent"" (ByVal hwnd As Long) As Long" & vbCr & _
"Declare Function GetWindowText Lib ""user32"" Alias ""GetWindowTextA"" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long" & vbCr & _
"Declare Function SetWindowLong Lib ""user32"" Alias ""SetWindowLongA"" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long" & vbCr & _
"Declare Function SetWindowText Lib ""user32"" Alias ""SetWindowTextW"" (ByVal hwnd As Long, ByVal lpString As String) As Long" & vbCr & _
"Declare Function EnumDisplaySettings Lib ""user32"" Alias ""EnumDisplaySettingsA"" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As DEVMODE) As Boolean" & vbCr & _
"Declare Function ChangeDisplaySettings Lib ""user32"" Alias ""ChangeDisplaySettingsA"" (lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long" & vbCr & _
"Type DEVMODE: dmDeviceName As String * 32: 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 As String * 32: dmUnusedPadding As Integer: dmBitsPerPel As Integer: dmPelsWidth As Long: dmPelsHeight As Long: dmDisplayFlags As Long: dmDisplayFrequency As Long: End Type" & vbCr & _
"Sub API_ChangeDisplaySettings (Width As Integer, Height As Integer): Dim data As DEVMODE: EnumDisplaySettings 0, -1, data: data.dmPelsWidth = Width: data.dmPelsHeight = Height: ChangeDisplaySettings data, 1: End Sub" & vbCr & _
"Function API_GetWindowText (hwnd) As String : Dim text As String : text=space(窗口标题长度) : GetWindowText hwnd,text,窗口标题长度+1 : API_GetWindowText=text : End Function"
oModule.CodeModule.AddFromString strCode Dim gamehwnd
gamehwnd = FindWindow()
if gamehwnd<>-1 then
oExcel.Run "SetWindowLong",gamehwnd,-16,113901568
oExcel.Run "SetWindowText",gamehwnd,"\Code By xfgryujk/"'*********要修改的窗口标题,可以去掉这句
oExcel.Run "API_ChangeDisplaySettings",1024,768'*********分辨率,根据需要自己改
Else
MsgBox "未找到窗口!",16,"通用窗口化"
End if oExcel.DisplayAlerts = False
oBook.Close
oExcel.Quit Function FindWindow()
Dim res,hwnd
res=-1
hwnd=oExcel.Run("GetWindow",oExcel.Run("GetDesktopWindow"),5)
Do While hwnd<>0
hwnd=oExcel.Run("GetWindow",hwnd,2)
if oExcel.Run("API_GetWindowText",hwnd)="窗口标题" then'*********要窗口化的窗口标题
res=hwnd
Exit do
End if
Loop
findwindow=res
End Function
我们不能把不认同和不忠诚混为一谈。——爱德华·R·默罗