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

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
   If Target.FormatConditions.Item.Font.ColorIndex <> 0 Then
     Cell.EntireRow.FormatConditions.Item.Font.ColorIndex = 0
   Else
     Target.FormatConditions.Item.Font.ColorIndex = 8
   End If
   Cancel = True
End Sub

1 ответ1

1

Я не понимаю, почему вы пытаетесь установить условный формат. Вы можете работать непосредственно с цветом шрифта. С черным = цветовой индекс 1 и серый = цветовой индекс 16:

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
     If Target.Font.ColorIndex <> 1 Then
         'not black? -> set to black
         Target.EntireRow.Font.ColorIndex = 1
     Else
         'black? -> set to grey
         Target.EntireRow.Font.ColorIndex = 16
     End If
     Cancel = True
End Sub

Этот код применяется только к конкретной рабочей таблице, в которую вы ввели код в редакторе VBA.

Чтобы действие автоматически применялось к каждому листу в рабочей книге, необходимо изменить ссылку на событие в объявлении процедуры на Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) .

Измененный код должен быть введен в область кода редактора для ThisWorkbook . (Нет необходимости изменять тело кода.)

Если вы хотите ограничить действие - и его результаты - конкретными столбцами или строками, требуется лишь скромное изменение подхода:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'   only double-clicks in columns B and C will trigger action
    If Not Intersect(Target, Sh.Range("B:C")) Is Nothing Then
        If Target.Font.ColorIndex <> 1 Then
'           only fonts in columns B and C will be modified
            Sh.Range("B:C").Font.ColorIndex = 1
        Else
            Sh.Range("B:C").Font.ColorIndex = 16
        End If
        Cancel = True
    End If
End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .