Coindicionar macro para ejecutar otra macro en hoja que corresponda

Dan muy buena tarde

Mira tengo esta macro que hice la cual se trata de impresion

En el cual es este:

Private Sub CommandButton30_Click()

MsgBox " Estas en la semana: " & Range("b951"), , "OBSERVACIÓN"
Dim msg As String
Dim Resp As String
msg = "¿Deseas Imprimir Reporte?."
Resp = MsgBox(msg, vbQuestion + vbYesNo, "PREGUNTA")
If Resp = vbYes Then
If ActiveSheet.Range("b951") = Sheets("REP X TURNO").Range("k5") Then Call IMPRESION1 Else
If ActiveSheet.Range("b951") = Sheets("REP X TURNO").Range("w5") Then Call IMPRESION2 Else
If ActiveSheet.Range("b951") = Sheets("REP X TURNO").Range("ai5") Then Call IMPRESION3 Else
If ActiveSheet.Range("b951") = Sheets("REP X TURNO").Range("au5") Then Call IMPRESION4 Else
If ActiveSheet.Range("b951") = Sheets("REP X TURNO").Range("bg5") Then Call IMPRESION5

End If
End Sub

If ActiveSheet.Range("b951") = Sheets("REP X TURNO").Range("k5") Then Call IMPRESION1

Lo que trato de decir es que

Si la hoja activa el rango b951 es igual ala hoja rep x turno rango k5 entonces que se ejecute la macro impresion1

FUNCIONA la macro pero imprime 2 veces (nose porque)

Entonces lo que quisiera es algo que seria asi

Si estoy situado en la hoja1. Name entonces que se ejecute la macro impresion1

Si estoy en la hoja2. Name se ejecute la macro impresion2 y asi sucesivamente

(No se si el error esta en que tengo puesto activesheet)

La macro de impresion1 es la misma que la 2,3,4,5 y es esta:

Sub IMPRESION1X()
'
' Macro4 Macro
'
' Acceso directo: CTRL+h
'UNO UNO
Sheets("REP X TURNO2").Activate
Application.ScreenUpdating = False
Sheets("REP X TURNO2").Unprotect
Application.ScreenUpdating = False
Dim lo As Variant
Set h1 = Hoja1
Cadena = Array("O1", "AA1", "AM1", "AY1", "BK1", "BW1", "CI1", "CU1", "DG1", "DS1", "EE1", "EQ1", "FC1", "FO1")
For Each cd In Cadena
If h1.Range(cd).Value > 0 Then cadenaNegativa = cadenaNegativa & cd & ", "
Next
If cadenaNegativa <> "" Then
MsgBox "Hay NEGATIVOS en la Siguiente celda: " & cadenaNegativa & Chr(10) & _
"Corrige para poder Imprimir.", vbCritical, "ERROR"
Exit Sub
End If
Sheets("REP X TURNO2").Unprotect
Range("C:D").Select
Selection.EntireColumn.Hidden = True
Application.ScreenUpdating = False
Application.ScreenUpdating = False
'' Dim respuesta As Variant
''respuesta = MsgBox("¿Ocultaste Columnas de DIFERENCIAS?", vbYesNo + vbExclamation, "VAS A IMPRIMIR")
'' If respuesta = vbYes Then
Cells.Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
Range("A:B"). EntireColumn. AutoFit
Range("A:B"). EntireColumn. AutoFit
Range("E:O"). EntireColumn. AutoFit
Range("R:AB"). EntireColumn. AutoFit
Range("AE:AO"). EntireColumn. AutoFit
Range("AR:BB"). EntireColumn. AutoFit
Range("BE:BL"). EntireColumn. AutoFit
End With
Range("A6:L45").Select
ActiveSheet.PageSetup.PrintArea = "$A$6:$L$45"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False

Cells.Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Application.ScreenUpdating = False
MsgBox "La impresion esta en proceso.", , "ATENCION"
''End If
'' If respuesta = vbNo Then
''End If
Sheets("REP X TURNO2").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True
Range("C:D").Select
Selection.EntireColumn.Hidden = False
ActiveSheet. Protect
WAO
End Sub

1 Respuesta

Respuesta
2

Imprime varias veces porque preguntas 5 veces por el valor de la celda B951, lo que tienes que hacer es preguntar una vez, quedaría así:

Private Sub CommandButton30_Click()
'Act.Por.Dante Amor
    MsgBox " Estas en la semana: " & Range("b951"), , "OBSERVACIÓN"
    Dim msg As String
    Dim Resp As String
    msg = "¿Deseas Imprimir Reporte?."
    Resp = MsgBox(msg, vbQuestion + vbYesNo, "PREGUNTA")
    If Resp = vbYes Then
        Select Case ActiveSheet.Range("b951")
            Case Sheets("REP X TURNO").Range("k5"): Call IMPRESION1
            Case Sheets("REP X TURNO").Range("w5"): Call IMPRESION2
            Case Sheets("REP X TURNO").Range("ai5"): Call IMPRESION3
            Case Sheets("REP X TURNO").Range("au5"): Call IMPRESION4
            Case Sheets("REP X TURNO").Range("bg5"): Call IMPRESION5
        End Select
    End If
End Sub


De esa forma solamente va a ejecutar la macro cuando la celda B951 sea igual a alguna de las 5 celdas

‘
F E L I Z A Ñ O T E D E S E A D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
:) 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas