返回列表 上一主題 發帖

[發問] 請教關於如何讓每一個sheet的圖片均有點擊放大縮小效果

回復 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. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  14.   '*** 新增程式:   還原 圖片的大小  ******
  15.     Dim Sh As Worksheet
  16.     Dim S As Shape                  'Shape: 代表圖形層中的物件,如快取圖案、手繪多邊形、OLE 物件或圖片
  17.     For Each Sh In Sheets           'Sheets: 工作表 物件的集合
  18.          For Each S In Sh.Shapes    'Shapes: Shape  物件的集合
  19.         If S.Name Like "圖片*" Then S.Height = dic(S.Name & "h"): S.Width = dic(S.Name & "w")
  20.         Next
  21.     Next
  22. End Sub
複製代碼

TOP

本帖最後由 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 的圖片
修改以 圖案類型= 照片,作為判斷.
  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
複製代碼

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
返回列表 上一主題