Excel VBA диапазон масштабирования

Question

If Target.Address = "$D$2:$F$861" Then 

    ActiveWindow.Zoom = 100 
    [A5000] = "zoomed" 
ElseIf [A5000] = "zoomed" Then 
    'Otherwise set the zoom to original 
    ActiveWindow.Zoom = 70 
    [A5000].ClearContents 
End If 

В приведенном выше коде If Target.Address = "$D$2:$F$861" Then не работает.

Я хочу увеличить масштаб, когда пользователь выбирает D2: F861.

Когда я набираю адрес одной ячейки, например $A$2, он работает.

Пожалуйста, помогите мне, что, когда пользователь может выбрать этой области изменения масштаба изображения до 100% в противном случае он остается на 70% или другой вариант он остается то, что пользователь устанавливает

---

Это не на самом деле диапазон сравнения. Он добавил новое значение, даже если вы выбираете из раскрывающегося списка с запятой в нужную ячейку.

Однако, если мы не получим шрифт большего размера из выпадающего списка. Я хочу добавить код для увеличения, выбрав ячейки, у которых есть раскрывающиеся списки.

---

Это полный код ниже:

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim rngDV As Range 
Dim oldVal As String 
Dim newVal As String 
Dim strVal As String 
Dim i As Long 
Dim lCount As Long 
Dim Ar As Variant 
On Error Resume Next 
Dim lType As Long 
If Target.Count > 1 Then GoTo exitHandler 



If Target.Address = "$D$2:$F$861" Then 

    ActiveWindow.Zoom = 100 
    [A5000] = "zoomed" 
ElseIf [A5000] = "zoomed" Then 
    'Otherwise set the zoom to original 
    ActiveWindow.Zoom = 70 
    [A5000].ClearContents 
End If 

lType = Target.Validation.Type 
If lType = 3 Then 
Application.EnableEvents = False 
newVal = Target.Value 
Application.Undo 
oldVal = Target.Value 
Target.Value = newVal 





    If oldVal = "" Then 
     'do nothing 
    Else 
     If newVal = "" Then 
      'do nothing 
     Else 
      On Error Resume Next 
      Ar = Split(oldVal, ", ") 
      strVal = "" 
      For i = LBound(Ar) To UBound(Ar) 
       Debug.Print strVal 
       Debug.Print CStr(Ar(i)) 
       If newVal = CStr(Ar(i)) Then 
        'do not include this item 
        strVal = strVal 
        lCount = 1 
       Else 
        strVal = strVal & CStr(Ar(i)) & ", " 
       End If 
      Next i 
      If lCount > 0 Then 
       Target.Value = Left(strVal, Len(strVal) - 2) 
      Else 
       Target.Value = strVal & newVal 
      End If 
     End If 
    End If 

End If 

exitHandler: 
    Application.EnableEvents = True 
End Sub 

Answer 1

Чтобы знать, если Target находится внутри требуемого диапазона, вы можете проверить его с этим:
If Not Application.Intersect(Target, Me.Range("$D$2:$F$861")) Is Nothing Then

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim rngDV As Range 
Dim oldVal As String 
Dim newVal As String 
Dim strVal As String 
Dim i As Long 
Dim lCount As Long 
Dim Ar As Variant 
On Error Resume Next 
Dim lType As Long 
If Target.Count > 1 Then GoTo exitHandler 


MsgBox "In event" 

If Not Application.Intersect(Target, Me.Range("$D$2:$F$861")) Is Nothing Then 
    MsgBox "In range" 
    ActiveWindow.Zoom = 100 
    Me.[A5000] = "zoomed" 
Else 
    If Me.[A5000] = "zoomed" Then 
     'Otherwise set the zoom to original 
     ActiveWindow.Zoom = 70 
     Me.[A5000].ClearContents 
    Else 
    End If 
End If 


MsgBox "Check validation" 
lType = Target.Validation.Type 
If lType = 3 Then 
    Application.EnableEvents = False 
    newVal = Target.Value 
    Application.Undo 
    oldVal = Target.Value 
    Target.Value = newVal 
    If oldVal = vbNullString Then 
     'do nothing 
    Else 
     If newVal = vbNullString Then 
      'do nothing 
     Else 
      On Error Resume Next 
      Ar = Split(oldVal, ", ") 
      strVal = vbNullString 
      For i = LBound(Ar) To UBound(Ar) 
       Debug.Print strVal 
       Debug.Print CStr(Ar(i)) 
       If newVal = CStr(Ar(i)) Then 
        'do not include this item 
        strVal = strVal 
        lCount = 1 
       Else 
        strVal = strVal & CStr(Ar(i)) & ", " 
       End If 
      Next i 
      If lCount > 0 Then 
       Target.Value = Left(strVal, Len(strVal) - 2) 
      Else 
       Target.Value = strVal & newVal 
      End If 
     End If 
    End If 
End If 

exitHandler: 
    Application.EnableEvents = True 
End Sub