Macro que cambie el color del Botón a la hora de guardar los datos
Para: Dante Amor
Recurriendo nuevamente a tu gran conocimiento en estos temas, tengo varias hojas que son idénticas y algunas no en las cuales las hojas idénticas tienen un botón y me gustaría que al pulsar este cambie el color de rojo a azul según la condiciones que tiene con la macro que me diste.
Sub Guardar()
'Por.Dante Amor
'Guarda los datos de cada hoja en la Hoja "BASE"
Application.ScreenUpdating = False
Set h = Sheets("Base")
Set h1 = ActiveSheet
Set b = h.Columns("B").Find(h1.Name, lookat:=xlWhole)
If Not b Is Nothing Then
res = MsgBox("Estos Datos ya existen, Desea cambiarla?", vbYesNo + vbExclamation, "")
If res = vbYes Then
h.Cells(b.Row, "C") = h1.[L6]
h.Cells(b.Row, "D") = h1.[N7]
MsgBox "Fin del proceso", vbInformation, ""
End If
Else
u = h.Range("B" & Rows.Count).End(xlUp).Row + 1
h.Cells(u, "B") = h1.Name
h.Cells(u, "C") = h1.[L6]
h.Cells(u, "D") = h1.[N7]
'
With h.Sort
Application.ScreenUpdating = False
.SortFields.Clear
.SortFields.Add Key:=h.Range("B5:B" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h.Range("B4:AQ" & u)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Application.ScreenUpdating = True
End With
'
MsgBox "Se a guardado correctamente", vbInformation
End If
End SubEspero que se entienda mi tema Gracias por la respuesta que me puedas dar.
1 respuesta
Te regreso la macro con el cambio.
Sub Guardar()
'Por. Dante Amor
'Guarda los datos de cada hoja en la Hoja "BASE"
Application.ScreenUpdating = False
Set h = Sheets("Base")
Set h1 = ActiveSheet
Set b = h.Columns("B").Find(h1.Name, lookat:=xlWhole)
If Not b Is Nothing Then
res = MsgBox("Estos Datos ya existen, Desea cambiarla?", vbYesNo + vbExclamation, "")
If res = vbYes Then
h.Cells(b.Row, "C") = h1.[L6]
h.Cells(b.Row, "D") = h1.[N7]
MsgBox "Fin del proceso", vbInformation, ""
End If
Else
u = h.Range("B" & Rows.Count).End(xlUp).Row + 1
h.Cells(u, "B") = h1.Name
h.Cells(u, "C") = h1.[L6]
h.Cells(u, "D") = h1.[N7]
'
With h.Sort
Application.ScreenUpdating = False
.SortFields.Clear
.SortFields.Add Key:=h.Range("B5:B" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h.Range("B4:AQ" & u)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Application.ScreenUpdating = True
End With
'
ActiveSheet.Shapes("1 Rectángulo redondeado").Select
Selection.Interior.ColorIndex = 5
MsgBox "Se a guardado correctamente", vbInformation
End If
End SubEn esta parte de la macro tienes que poner el nombre de la figura:
"1 Rectángulo redondeado"
Así ves el nombre de la figura, selecciona la figura y en el cuadro de nombre se ve el nombre de la figura:
S a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
Gracias! Dante Amor
La macro esta perfecta y esta trabajando perfectamente , bueno no se si es mucho pedir Amigo Dante si con un botón adicional pueda hacer que todos los botones cambien al color rojo ya que cada mes tengo que poner nuevos datos a las hojas y guardarlas, espero que no sea mucho pedir de esta parte mas amigo Dante.
No hay problema, con gusto te ayudo con la macro, valora esta respuesta y crea una nueva pregunta.
