Aprire un nuovo file. Andare nella cartella Sviluppo. Fare doppio click sull'elemento ThisWorkbook. Nell'editor copiare il codice sottostante
'--------------------------------------------------------
Private m_LastCell As Range
Private m_LastSheet As Object
Sub MarkCross(rng As Range, Sht As Object)
Dim ScrUp_old As Boolean
'Verifico che sia selezionata solo una cella
If rng.Cells.Count = 1 Then
ScrUp_old = Application.ScreenUpdating
Application.ScreenUpdating = False
'Tolgo precedenti evidenziazioni
Sht.Cells.Select
Selection.Interior.ColorIndex = xlNone
'Evidenzio la riga
Sht.Rows(rng.Row).Select
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
'Evidenzio la colonna
Sht.Columns(rng.Column).Select
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End If
rng.Select
Application.ScreenUpdating = ScrUp_old
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If m_LastCell Is Nothing And m_LastSheet Is Nothing Then
Set m_LastCell = Target
Set m_LastSheet = Sh
MarkCross Target, Sh
Set m_LastCell = Nothing
Set m_LastSheet = Nothing
End If
End Sub
'--------------------------------------------------------
Adesso quando si seleziona una cella, si evidenzia la riga e la colonna corrispondente.
tratto da VBA
1 commento:
Ciao. Funziona ma a patto di non avere delle ceel gia' colorate che ti servono cosi', perche' questa macro cancella tutti i riempimenti del foglio
Posta un commento