- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2013-1-9 15:24 編輯
回復 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 的圖片
修改以 圖案類型= 照片,作為判斷.- Private Sub Workbook_Open()
- Set dic = CreateObject("Scripting.Dictionary")
- Dim Sh As Worksheet
- Dim S As Shape 'Shape: 代表圖形層中的物件，如快取圖案、手繪多邊形、OLE 物件或圖片
- For Each Sh In Sheets 'Sheets: 工作表 物件的集合
- For Each S In Sh.Shapes 'Shapes: Shape 物件的集合
- If S.Type = msoPicture Then 'S.Type(圖案類型): 照片
- S.OnAction = "nn"
- dic(S.Name & "h") = S.Height
- dic(S.Name & "w") = S.Width
- End If
- Next
- Next
- End Sub
- Private Sub Workbook_BeforeClose(Cancel As Boolean)
- '*** 新增程式: 還原 圖片的大小 ******
- Dim Sh As Worksheet
- Dim S As Shape 'Shape: 代表圖形層中的物件，如快取圖案、手繪多邊形、OLE 物件或圖片
- For Each Sh In Sheets 'Sheets: 工作表 物件的集合
- For Each S In Sh.Shapes 'Shapes: Shape 物件的集合
- If S.Type = msoPicture Then S.Height = dic(S.Name & "h"): S.Width = dic(S.Name & "w")
- Next
- Next
- End Sub
|
|
發表於 2013-1-8 16:50
| 