Excel Shape нарушает настройки Windows Display Zoom

Question

Я хотел бы получить точную позицию фигуры в Excel.Я заметил, что Shape.Top нарушается настройками Windows Display Zoom.

Чтобы воспроизвести ошибку, щелкните правой кнопкой мыши имя листа> Просмотр кода> и вставьте код VBA вVBA редактор листа.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
    On Error Resume Next
    ThisWorkbook.ActiveSheet.Shapes("BlueRectangle").Delete

    Dim sh As Object
    Set sh = ThisWorkbook.ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height)
    sh.Name = "BlueRectangle"
End Sub

Этот код создает форму Rectange в ячейке с двойным щелчком.Все работает нормально, если масштаб отображения настроек Windows установлен на 100%.Однако, когда мы изменяем масштаб отображения в настройках Windows на 125%, прямоугольник создается в немного другом месте, чем активная ячейка.Существует разница в 1 строку в высоте расположения для каждых 100 строк Excel.Поэтому, когда я щелкаю по ячейке A100 , прямоугольник создается в ячейке A99 .

Я хотел бы исправить создание местоположения Прямоугольник так, чтобы был выбран Windows Zoom Display.в учетную запись.

Вот поведение со 100% масштабированием дисплея:

Вот ошибочное поведение, которое я хотел бы исправить, что происходит с 125% масштабированием дисплея:

Ниже приведено незаметное задание, которое я бросил на SO, что может стать вехой в ответе на этот вопрос: Получить значение масштабирования экрана Windows

Answer 1

Я не могу воспроизвести вашу проблему.Я работаю со 150%, и в Excel правильное позиционирование даже для самых последних ячеек.

Также не нужно ничего исправлять.

Но могут быть некоторые проблемы с вашимкод:

• Избегайте ThisWorkbook.ActiveSheet и используйте Target.Parent, это более надежно.
• Также избегайте использования ActiveCell и используйте Target, поскольку ActiveCell, возможно, не изменилсяна ячейку, на которую вы нажали еще.Target - это ячейка, в которой вы дважды кликнете , а не ActiveCell.

Попробуйте попробовать следующее.Я забыл, что проблема в DPI, и я подозреваю, что это проблема, связанная с ActiveCell.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True

    On Error Resume Next
    Target.Parent.Shapes("BlueRectangle").Delete
    On Error GoTo 0 'always re-activate error handling after an expected error

    Dim shp As Shape
    Set shp = Target.Parent.Shapes.AddShape(msoShapeRectangle, Target.Left, Target.Top, Target.Width, Target.Height)
    shp.Name = "BlueRectangle"
End Sub