请问这段代码要改为工作薄的所有工作表同时执行，怎么弄？

naturalcyh1

谢谢各位，我的工作表改了名字的，为“风景图表”、“商务图表”、“建筑图标”………………
代码如下：


Const beishu = 3 '在这里调整放大倍数，当前为2倍
Sub 单击图片放大()
Dim target, sht, rn, mypath, shp, i
For Each shp In Sheets(1).Shapes
  shp.OnAction = "ActionClick"
Next
End Sub

Sub ActionClick()
Static n, x
    Application.ScreenUpdating = False
If x = Application.Caller Then
    n = n + 1
    If (n Mod 2) = 1 Then
    With Sheet1.Shapes(Application.Caller)
        .ScaleHeight beishu, msoFalse, msoScaleFromTopLeft
        .ScaleWidth beishu, msoFalse, msoScaleFromTopLeft
        .ZOrder msoBringToFront
    End With
    Else
    With Sheet1.Shapes(Application.Caller)
        .ScaleHeight 1 / beishu, msoFalse, msoScaleFromTopLeft
        .ScaleWidth 1 / beishu, msoFalse, msoScaleFromTopLeft
        .ZOrder msoBringToFront
    End With
    End If
Else
    If (n Mod 2) = 1 Then
      With Sheet1.Shapes(x)
        .ScaleHeight 1 / beishu, msoFalse, msoScaleFromTopLeft
        .ScaleWidth 1 / beishu, msoFalse, msoScaleFromTopLeft
        .ZOrder msoBringToFront
      End With
      With Sheet1.Shapes(Application.Caller)
        .ScaleHeight beishu, msoFalse, msoScaleFromTopLeft
        .ScaleWidth beishu, msoFalse, msoScaleFromTopLeft
        .ZOrder msoBringToFront
      End With
    Else
      With Sheet1.Shapes(Application.Caller)
        .ScaleHeight beishu, msoFalse, msoScaleFromTopLeft
        .ScaleWidth beishu, msoFalse, msoScaleFromTopLeft
        .ZOrder msoBringToFront
      End With
      n = n + 1
    End If
      x = Application.Caller

End If
    Application.ScreenUpdating = True
End Sub

su45

好像代码与标题不搭呀

metoo77

无法实现多线程操作

su45

二楼的回复是你改了标题前发的。说明下。