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
не работает.Excel VBA диапазон масштабирования
Я хочу увеличить масштаб, когда пользователь выбирает 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
Что «Делает не работают "? Вы получаете сообщение об ошибке? Вы отлаживались, и это условие никогда не выполняется? –
'If Not Intersect (Target, range (" $ D $ 2: $ F $ 861 ")) - это ничего, кроме' – SJR
@SJR: Я тоже очень противен, но это будет только сказать, если Target находится в диапазоне. – R3uK