Ripetere pulsante con macro su altre righe

Question

Buongiorno

Sono poco pratico su excel

Avrei bisogno di estendere una macro creata su una riga

su tutte le altre righe, azionabile dai pulsanti

(in pratica con azionare i pulsanti le righe devono cambiare colore)

Allego foto per comprendere meglio le mie intenzioni

grazie

Answer 1

Se ho capito tu vuoi, tramite i due pulsanti, assegnare uno sfondo, cliccando su OK, o eliminare lo sfondo, cliccando su NO, alla riga della "tabella".

Invece di creare tanti pulsanti si può pensare di fare in modo che i soli due pulsanti si spostino a seconda che la cella attiva si trovi tra la prima riga successiva alle intestazioni di colonna e l'ultima riga della "tabella".

Vedi se questo esempio ti può essere di spunto: File esempio

Nel Foglio1 ho creato una Tabella (Inserici-Tabelle-Tabella o, in alternativa, Home-Stili-Formatta come tabella) in corrispondenza dell'intervallo di interesse. Alla tabella ho impostato una "formattazione" corrispondente allo stile "Nessuno" (in pratica è come avere l'intervallo della tabella senza alcuna formattazione "pre impostata").

Con la Tabella è possibile avere un riferimento "fisso" e anche se varierà il numero di righe (o di colonne), potrà essere "intercettata" dalla procedura VBA con il semplice riferimento alla stessa.

Nel modulo di classe del progetto VBA del Foglio1 ho inserito questo codice che sposta i due pulsanti se la riga di una qualsiasi cella attiva è compresa tra la riga successiva a quella delle intestazioni di colonna e l'ultima riga della tabella:

'---

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   Dim oLO As ListObject

   Dim r As Range

   Dim pOK As Shape, pNO As Shape

   Dim iRigaI As Long, iRigaF As Long

   Set oLO = Me.ListObjects(1)

   Set r = ActiveCell

   Set pOK = Me.Shapes("PulsanteOK")

   Set pNO = Me.Shapes("PulsanteNO")

   With oLO

      iRigaI = .Range.Row + 1

      iRigaF = .Range.Row + .DataBodyRange.Rows.Count

   End With

   If r.Row >= iRigaI And r.Row <= iRigaF Then

      With pOK

         .Height = r.Height - 5

         .Top = r.Top + 2.5

      End With

      With pNO

         .Height = pOK.Height

         .Top = pOK.Top

      End With

   End If

End Sub

'---

Nel modulo standard Modulo1 ho inserito due macro collegate a ciascun pulsante e una macro che a seconda che il comando parta dal pulsante OK o dal pulsante NO imposta lo sfondo, o lo elimina, dalla riga della tabella in corrispondenza della cella attiva:

'---

Option Explicit

Sub PulsanteOK_Click()

   Call ImpostaSfondoRigaTabella("OK")

End Sub

Sub PulsanteNO_Click()

   Call ImpostaSfondoRigaTabella("NO")

End Sub

Sub ImpostaSfondoRigaTabella(OKorNO As String)

   Dim vColor As Long

   Dim oLO As ListObject

   Dim iRiga As Long

   Select Case OKorNO

      Case "OK"

         vColor = 5296274

      Case "NO"

         vColor = xlNone

   End Select

   Set oLO = ActiveSheet.ListObjects(1)

   With oLO

      iRiga = ActiveCell.Row - .Range.Row

      .ListRows(iRiga).Range.Interior.Color = vColor

   End With

End Sub

'---

Vedi tu se ti può essere di aiuto e di spunto per il tuo lavoro.