Hoja Con Botones Flotantes Donde No Se Puede Tener Botones.

[gusmario2022]

Hola comparto con ustedes una archivo de excel con una hoja, que tiene botones flotantes. Al iniciar la hoja los botones se pondran de color rojo (significa que no han sido usados) una vez se de click sobre uno, en la secuencia el siguiente se pondra en color amarillo (significa que es el que sigue de usarse), el anterior se pondra de color verde (significa que se ha utilizado ya y si se da click en el mostrara un mensaje diciendo que no es posible repetir la accion de este boton, ya que ha sido utilizado), despues de usar el boton amarillo, este se pondra de color verde y el que sigue cambiara a amarillo y asi sucesivamente. Donde de un click con el raton los botones le seguiran pero siempre estaran hubicados a 5 celdas a la derecha y tomaran el tamaño de los gruesos de los renglones.

Espero les sirva como a mi, donde no se puede tener botones (por que se borra todo dato de esa hoja) y se requiere botones, ademas de que determina una secuencia a seguir a prueba de erorr si es que otras personas usan el archivo.

https://mega.nz/file/JG1wDbpA#Jhzm8ryLMFr1ff8-AfInhJWcYa_1bOMLuBfvuG--DG8

Saludos desde Mexico.

[Antoni]

Te dejo tus macros algo más reducidas.

Sustitúyelas por estas:

Asignar macro a los círculos, debes ejecutarla una sola vez:

Sub AsignarMacro()
'Asigna la macro Ovalos a todas las formas
Dim s As Shape
For Each s In ActiveSheet.Shapes
   If s.Name Like "Flotante*" Then s.OnAction = "Sheet3.Ovalos"
Next
End Sub

Posicionar círculos:

Private Sub Worksheet_SelectionChange(ByVal Target As Range): On Error Resume Next
'Procedimiento para ubicar los ovalos
Const xTop As Integer = 40
Const xLeft As Integer = 50
Dim x As Integer, y As Integer, s As Shape
For Each s In ActiveSheet.Shapes
   If s.Name Like "Flotante*" Then
      y = Mid(s.Name, 13)
      s.Top = ActiveCell.Top + xTop * x
      s.Left = ActiveCell.Left + ((1 - (y Mod 2)) + 1) * xLeft
      If y Mod 2 = 0 Then x = x + 1
   End If
Next
Exit Sub
End Sub

Inicializar círculos al activar la hoja:

Private Sub Worksheet_Activate(): On Error Resume Next
'Cambia las formas de color a verde al activar la hoja
Dim s As Shape
Application.ScreenUpdating = False
For Each s In ActiveSheet.Shapes
   If s.Name Like "Flotante*" Then s.Fill.ForeColor.RGB = vbGreen
Next
End Sub

Acciones al pulsar sobre los circulos:

Sub Ovalos(): On Error Resume Next
'Cambio de color shapes (formas)
Application.ScreenUpdating = False
y = Mid(Application.Caller, 13)
Select Case ActiveSheet.Shapes(Application.Caller).Fill.ForeColor.RGB
   Case vbGreen
      ActiveSheet.Shapes(Application.Caller).Fill.ForeColor.RGB = vbYellow
      MsgBox "Acción 1, Botón " & y, vbInformation
   Case vbYellow
      ActiveSheet.Shapes(Application.Caller).Fill.ForeColor.RGB = vbRed
      MsgBox "Acción 2 Botón " & y, vbInformation
   Case vbRed
      ActiveSheet.Shapes(Application.Caller).Fill.ForeColor.RGB = vbGreen
      MsgBox "Acción 3 Botón " & y, vbInformation
End Select
End Sub

 

Botones Flotantes.xlsb

[gusmario2022]

Excelente Antoni, esta mucho mas limpio el codigo, espero le puedan dar un gran uso los usuraios del citio.

 

Saludos desde Mexico.