標題: [發問] 請教:如何在使用activesheet後,再限制特定工作表不執行程式 [打印本頁]

---

作者: cmo140497    時間: 2013-1-14 09:45     標題: 請教:如何在使用activesheet後,再限制特定工作表不執行程式

本帖最後由 GBKEE 於 2013-1-14 15:40 編輯

Dear :
小弟修正於各工作表上執行圖片放大縮小動作,因工作表數視載入檔案多少不一定,但因其有二頁工作表不需做其圖片放大縮小動作,不知要如何修正,請各位大大幫忙指引一下迷津,感恩!

1. Private Sub Workbook_Open()
   
2. Set dic = CreateObject("Scripting.Dictionary")
   
3. Dim Sh As Shape
   
4. Dim SHT As Worksheet
   
5. Dim DaSht As String, CALSht As String
   
6. DaSht = "DashBoard": CALSht = "CALS" ' 這二個工作表不做shape放大縮小動作
   
7. 
   
8.     For Each SHT In Sheets
   
9.         Do While SHT Is Nothing
   
10.             If SHT.Name = DaSht Or SHT.Name = CALSht Then
    
11.             Exit Do
    
12.             Else
    
13.                 For Each Sh In SHT.Shapes ' 連同註解的文字方塊或圖表也會被認為是shape,開檔案時會alert
    
14.                 With Sh
    
15.                     Sh.OnAction = "nn"
    
16.                     dic(Sh.Name & "h") = Sh.Height
    
17.                     dic(Sh.Name & "w") = Sh.Width
    
18.                 End With
    
19.                 Next
    
20.             End If
    
21.         Loop
    
22.     Next
    
23.    
    
24. End Sub
    
25. 
    
26. 
    
27. 
    
28. Sub nn()
    
29. With ActiveSheet.Shapes(Application.Caller)
    
30. '---變更為在自己的位置作放大縮小的動作
    
31.     If .Height <> dic(.Name & "h") Then
    
32.     .Height = dic(.Name & "h")
    
33.     .Width = dic(.Name & "w")
    
34.     Else
    
35.     .Height = dic(.Name & "h") * 8
    
36.     .Width = dic(.Name & "w") * 8
    
37.     .ZOrder msoBringToFront
    
38.     End If
    
39. End With
    
40. End Sub

複製代碼

[attach]13926[/attach]

---

作者: cmo140497    時間: 2013-1-14 11:50

回復 1# cmo140497


    已自行解決了,感恩!

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)