Как показать увеличенную ячейку всегда в другой фиксированной ячейке?

Question

Я создаю обзорный лист отчета в Excel, чтобы увеличить выбранную ячейку.

Прямо сейчас я смог заставить его работать в левом верхнем углу активной ячейки, но я не могу понять, как переместить изображение в верхний левый угол фиксированной ячейки.

Private Sub worksheet_selectionchange(ByVal Target As Range)
'Sub za zoom in celic D3:W39


Dim xRg As Range
Dim xCell As Range
Dim xShape As Variant
Set xRg = Target.Areas(1)

If InRange(ActiveCell, Range("D3:W40")) Then

For Each xShape In ActiveSheet.Pictures
    If xShape.Name = "zoom_cells" Then
        xShape.Delete
    End If
Next
If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
Application.ScreenUpdating = False
xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
Application.ActiveSheet.Pictures.Paste.Select
With Selection
    .Name = "zoom_cells"
    With .ShapeRange
        .ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
        With .Fill
            .ForeColor.SchemeColor = 44
            .Visible = msoTrue
            .Solid
            .Transparency = 0
        End With
    End With
End With
xRg.Select
Application.ScreenUpdating = True
Set xRg = Nothing
End If
End Sub

Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function

Содержимое любой активной ячейки в пределах указанного диапазона должно увеличиваться (уже есть), но должно отображаться в фиксированном месте (скажем, в верхнем левом углу ячейки X3).

Нужна помощь, поскольку это моя первая попытка в VBA.

С уважением, W

Answer 1

Это можно сделать, просто добавив параметры .Left и .Top.

Внутри существующего кода у вас есть:

With Selection
    .Name = "zoom_cells"
    With .ShapeRange
        .ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft

Измените его на:

With Selection
    .Left = .Parent.Range("X3").Left
    .Top = .Parent.Range("X3").Top
    .Name = "zoom_cells"
    With .ShapeRange
        .ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft