Блог

Я разрабатываю приложение в Excel, однако оно занимает лишь небольшое количество «недвижимости» на рабочем листе. У меня есть приведенный ниже код для соответствующего изменения размера окна при открытии, однако оно не открывается в центре экрана. Как я могу это сделать? Спасибо!

 Private Sub Workbook_Open()
    Toggle False 'toggle off excel ribbon, headings, scroll bars, formula amp; status bars
    Application.WindowState = xlNormal
    Application.Width = 358
    Application.Height = 324
    'irrelevant code
End Sub
 

Это то, что вы пытаетесь сделать?

 Option Explicit

Private Declare PtrSafe Function GetSystemMetrics Lib "user32" _
(ByVal Index As Long) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal Index As Long) As Long

Private Sub Workbook_Open()
    Dim ScreensWidth As Single
    Dim ScreensHeight As Single

    ScreensWidth = GetSystemMetrics(78)
    ScreensHeight = GetSystemMetrics(79)
   
    ScreensWidth = ConvertPixelsToPoints(ScreensWidth, "X")
    ScreensHeight = ConvertPixelsToPoints(ScreensHeight, "Y")
    
    With Application
        .WindowState = xlNormal
        .Width = 358
        .Height = 324
    
        .Left = (ScreensWidth - .Width) / 2
        .Top = (ScreensHeight - .Height) / 2
    End With
End Sub

Private Function ConvertPixelsToPoints(ByVal pxls As Single, _
                                       ByVal XorY As String) As Single
    Dim hDC As Long

    hDC = GetDC(0)
    If XorY = "X" Then ConvertPixelsToPoints = pxls * (72 / GetDeviceCaps(hDC, 88))
    If XorY = "Y" Then ConvertPixelsToPoints = pxls * (72 / GetDeviceCaps(hDC, 90))
    Call ReleaseDC(0, hDC)
End Function
 

Чтобы понять, что делает каждый API, я бы указал вам на мой любимый сайт для списка API

В Действии