Ejecutar codigo como sub y no como private
Para elsa:
Como puedo modificar este código y ejecutarlo como modulo
Private Sub SpinButton1_Change() Dim n%, valor As String ' <= variable agregada ' Application.ScreenUpdating = False If [A1] = "0000" Then Exit Sub valor = Format([A1], "0000") ' <= formato agregado ' For i = 1 To Sheets.Count Sheets(i).Activate [A1] = valor For n = 1 To Len(valor) BuscarÁrea n, Mid(valor, n, 1), 4, 13 BuscarÁrea n, Mid(valor, n, 1), 17, 26 Next Next End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address Like "$A$*" Then If Not ActiveCell = "" Then If IsNumeric(ActiveCell) Then SpinButton1 = ActiveCell End If End If End Sub 'y buscar area Sub BuscarÁrea(n As Integer, Número As Integer, x1 As Long, x2 As Long) Application.ScreenUpdating = False y = (n - 1) * 2 + 5 'empieza en col E aTablas: Range(Cells(x1, y), Cells(x2, y)).Interior.ColorIndex = xlNone For x = x1 To x2 If Cells(x, y) = Número Then Cells(x, y).Interior.Color = vbRed 'pasa a la tbla siguiente GoTo siguenTablas End If Next siguenTablas: 'sigue con otras tablas y = y + 9 If y > 57 Then Exit Sub GoTo aTablas End Sub
1 Respuesta
Respuesta de Elsa Matilde
1
Ya te devolveré tu libro con la macro modificada.
PD) Olvidé comentar en respuesta anterior que la macro para eliminar objetos puede ser utilizada en cualquier hoja. Solo eliminará los objetos llamados AutoShape que en tu caso fueron controles Spin.
Sdos y no olvides valorar la respuesta.
¡Gracias!
Me disculpó por la valoración
Debes quitar las macros que se encuentran en el objeto HOJA Actual, ya que el nuevo código irá en un módulo y se ejecutará a continuación de las demás (dentro del formulario)
Sub hoja_actual() 'macro hoja Actual a Dbre'2021
Dim n%, valor As String ' <= variable agregada '
Sheets("actual").Select
ActiveSheet.Range("A1").Value = Sheets("Hoja1").Range("H1").Value
Application.ScreenUpdating = False
If [A1] = "0000" Then Exit Sub
valor = Format([A1], "0000") ' <= formato agregado '
For n = 1 To Len(valor)
BuscarÁrea n, Mid(valor, n, 1), 4, 13
BuscarÁrea n, Mid(valor, n, 1), 17, 26
Next
End Sub
Sub BuscarÁrea(n As Integer, Número As Integer, x1 As Long, x2 As Long)
'macro proceso hoja Actual a Dbre'2021
Application.ScreenUpdating = False
y = (n - 1) * 2 + 5 'empieza en col E
aTablas:
Range(Cells(x1, y), Cells(x2, y)).Interior.ColorIndex = xlNone
'opcional:quitar bordes anteriores
Range(Cells(x1, y), Cells(x2, y)).Borders.LineStyle = xlNone
'colorea de rojo
For x = x1 To x2
If Cells(x, y) = Número Then
Cells(x, y).Interior.Color = vbRed
'pasa a la tbla siguiente
GoTo siguenTablas
End If
Next x
siguenTablas:
'sigue con otras tablas
y = y + 9
If y > 57 Then Exit Sub
GoTo aTablas
End SubAdjunto libro ajustado.
Sdos!
