Anexar resultados de varias macros

Hola, tengo dos macros en excel que dan un valor, lo toman de tablas distintas, y lo colocan sobre un mapa. El problema es que necesito crear otra macro que al picar en un botón me de ambos valores a la vez sobre dicho mapa.

Estas son las dos macros:

1.-

Public Colores(15)
Sub ColorearProvinciasSLA()
Application.ScreenUpdating = False
For X = 4 To 18: Colores(X - 3) = Range("Z" & X).Interior.Color: Next
For i = 4 To 55
ActiveSheet.Shapes(Range("L" & i).Value).Select
Selection.ShapeRange.Fill.ForeColor.RGB = Colores(Range("N" & i).Value)
Next i
PonerCartelesSLA
ActiveCell.Select
Application.ScreenUpdating = True
End Sub
Sub PonerCartelesSLA(): On Error Resume Next
Application.ScreenUpdating = False
For X = 4 To 55
ActiveSheet.Shapes(Range("K" & X).Address).Delete
H = ActiveSheet.Shapes(Range("K" & X)).Height
W = ActiveSheet.Shapes(Range("K" & X)).Width
ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
Range("R" & X) + (W / 4), Range("P" & X) + (H / 4), 30, 18).Select
With Selection
.Name = Range("K" & X).Address
.OnAction = "VerProvinciaSLA"
End With
With Selection.ShapeRange
.Line.Visible = msoFalse
.Fill.Visible = msoFalse
With .TextFrame2.TextRange.Characters
.Text = Range("M" & X) * 100
.Font.Size = 8
.Font.Bold = True
End With
With .TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
End With
Next
ActiveCell.Select
Application.ScreenUpdating = True
End Sub
Sub VerProvinciaSLA()
MsgBox Range(Application.Caller).Value, vbInformation, "Provincia"
End Sub

2.-

Public Colores(15)
Sub ColorearProvinciasVOL()
Application.ScreenUpdating = False
For X = 4 To 18: Colores(X - 3) = Range("Z" & X).Interior.Color: Next
For i = 4 To 55
ActiveSheet.Shapes(Range("L" & i).Value).Select
Selection.ShapeRange.Fill.ForeColor.RGB = Colores(Range("N" & i).Value)
Next i
PonerCartelesVOL
ActiveCell.Select
Application.ScreenUpdating = True
End Sub
Sub PonerCartelesVOL(): On Error Resume Next
Application.ScreenUpdating = False
For X = 4 To 55
ActiveSheet.Shapes(Range("K" & X).Address).Delete
H = ActiveSheet.Shapes(Range("K" & X)).Height
W = ActiveSheet.Shapes(Range("K" & X)).Width
ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
Range("V" & X) + (W / 4), Range("T" & X) + (H / 4), 30, 18).Select
With Selection
.Name = Range("K" & X).Address
.OnAction = "VerProvinciaVOL"
End With
With Selection.ShapeRange
.Line.Visible = msoFalse
.Fill.Visible = msoFalse
With .TextFrame2.TextRange.Characters
.Text = Range("O" & X)
.Font.Size = 8
.Font.Bold = True
End With
With .TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
End With
Next
ActiveCell.Select
Application.ScreenUpdating = True
End Sub
Sub VerProvinciaVOL()
MsgBox Range(Application.Caller).Value, vbInformation, "Provincia"
End Sub

Si necesitas el fichero te lo puedo enviar.

Gracias.

1 respuesta

Respuesta

Normalmente para "juntar dos macros" lo que se hace es copiar el código de una después de la otra... y se crea una macro más grande...

Otra alternativa es crear una tercera macro que invoque a ambas como por ejemplo:

Sub MacroTotal

ColorearProvinciasSLA

ColorearProvinciasVOL

End Sub

Y luego asignas esta macro al botón o combinación de teclas que desees

Ambas opciones las he probado, en el caso de copiar el código de una en la otra no ha funcionado, ya que no ha hecho nada. No lo entiendo.

Y en el caso de utilizar esta segunda opción:

Sub MacroTotal
ColorearProvinciasSLA
ColorearProvinciasVOL
End Sub

lo que hace es ejecutar primero ColorearProvinciasSLA y luego ColorearProvinciasVOL, desparareciendo ColorearProvinciasSLA.

Si puedes pasarme el archivo... lo reviso

Saludos,

Jaime

[email protected]

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas