GBKEE

回復 1# cmo140497
試試看

1. Private Sub Workbook_Open()
   
2.     Set dic = CreateObject("Scripting.Dictionary")
   
3.     Dim Sh As Worksheet
   
4.     Dim S As Shape                  'Shape: 代表圖形層中的物件，如快取圖案、手繪多邊形、OLE 物件或圖片
   
5.    
   
6.     For Each Sh In Sheets           'Sheets: 工作表 物件的集合
   
7.          For Each S In Sh.Shapes    'Shapes: Shape  物件的集合
   
8.         If S.Name Like "圖片*" Then S.OnAction = "nn": dic(S.Name & "h") _
   
9.             = S.Height: dic(S.Name & "w") = S.Width
   
10.         Next
    
11.     Next
    
12. End Sub
    
13. 
    
14. Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
15.   '*** 新增程式:   還原 圖片的大小  ******
    
16.     Dim Sh As Worksheet
    
17.     Dim S As Shape                  'Shape: 代表圖形層中的物件，如快取圖案、手繪多邊形、OLE 物件或圖片
    
18.     For Each Sh In Sheets           'Sheets: 工作表 物件的集合
    
19.          For Each S In Sh.Shapes    'Shapes: Shape  物件的集合
    
20.         If S.Name Like "圖片*" Then S.Height = dic(S.Name & "h"): S.Width = dic(S.Name & "w")
    
21.         Next
    
22.     Next
    
23. End Sub

複製代碼

GBKEE

回復 5# cmo140497
新增圖片是不是一定得存檔: 可隨你的意.
Sheet1 4個圖片名稱為 Picture 1,Picture 2,圖片 1,圖片 2
Sheet2 3個圖片名稱為 圖片 3,圖片 2,圖片 1
If Sh.Name Like "圖片*" Then   : 無法讀出Sheet1  Picture 1,Picture 2 的圖片
修改以 圖案類型= 照片,作為判斷.

1. Private Sub Workbook_Open()
   
2.     Set dic = CreateObject("Scripting.Dictionary")
   
3.     Dim Sh As Worksheet
   
4.     Dim S As Shape                          'Shape: 代表圖形層中的物件，如快取圖案、手繪多邊形、OLE 物件或圖片
   
5.     For Each Sh In Sheets                   'Sheets: 工作表 物件的集合
   
6.         For Each S In Sh.Shapes             'Shapes: Shape  物件的集合
   
7.             If S.Type = msoPicture Then     'S.Type(圖案類型): 照片
   
8.                 S.OnAction = "nn"
   
9.                 dic(S.Name & "h") = S.Height
   
10.                 dic(S.Name & "w") = S.Width
    
11.             End If
    
12.         Next
    
13.     Next
    
14. End Sub
    
15. Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
16.   '*** 新增程式:   還原 圖片的大小  ******
    
17.     Dim Sh As Worksheet
    
18.     Dim S As Shape                  'Shape: 代表圖形層中的物件，如快取圖案、手繪多邊形、OLE 物件或圖片
    
19.     For Each Sh In Sheets           'Sheets: 工作表 物件的集合
    
20.         For Each S In Sh.Shapes    'Shapes: Shape  物件的集合
    
21.             If S.Type = msoPicture Then S.Height = dic(S.Name & "h"): S.Width = dic(S.Name & "w")
    
22.         Next
    
23.     Next
    
24. End Sub

複製代碼