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.