返回列表 上一主題 發帖

一個放大圖片問題

回復 1# 317

按一下放大,再按一下還原
    ShowPicture.zip (190.74 KB)
學海無涯_不恥下問

TOP

回復 3# 317
直接合併不衝突阿
  1. Private Sub Workbook_Open()
  2. Set dic = CreateObject("Scripting.Dictionary")
  3. Dim sh As Shape
  4. For Each sh In Sheet1.Shapes
  5.    If sh.Name Like "Picture*" Then sh.OnAction = "nn": dic(sh.Name & "h") = sh.Height:: dic(sh.Name & "w") = sh.Width
  6. Next
  7. UserForm1.Show
  8. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 6# 317


    插入圖片後存檔再開啟檔案測試看看
學海無涯_不恥下問

TOP

回復 9# 周大偉

放大顯示於A1儲存格
  1. Private Sub Workbook_Open()
  2. Set dic = CreateObject("Scripting.Dictionary")
  3. Dim sh As Shape
  4. For Each sh In Sheet1.Shapes
  5. With sh
  6.    If .Name Like "Picture*" Then .OnAction = "nn": dic(.Name) = Array(.Top, .Left, .Height, .Width)
  7. End With
  8. Next
  9. End Sub
複製代碼
一般模組
  1. Public dic
  2. Sub nn()
  3. With Sheet1.Shapes(Application.Caller)
  4. If .Left = ActiveSheet.[A1].Left Then
  5. .Top = dic(.Name)(0)
  6. .Left = dic(.Name)(1)
  7. .Height = dic(.Name)(2)
  8. .Width = dic(.Name)(3)
  9. Else
  10. .Height = dic(.Name)(2) * 3
  11. .Width = dic(.Name)(3) * 3
  12. .Top = ActiveSheet.[A1].Top
  13. .Left = ActiveSheet.[A1].Left
  14. .ZOrder msoBringToFront
  15. End If
  16. End With
  17. End Sub
複製代碼
ShowPicture.zip (196.18 KB)
學海無涯_不恥下問

TOP

本帖最後由 Hsieh 於 2011-10-23 16:41 編輯

回復 13# 317

在這句
If sh.Name Like "Picture*"
因為你插入的圖片名稱是中文"圖片3"
所以沒有指定巨集給他
  1. Private Sub Workbook_Open()
  2. Set dic = CreateObject("Scripting.Dictionary")
  3. Dim sh As Shape
  4. For Each sh In Sheet1.Shapes
  5.    If sh.Name Like "Picture*" Or sh.Name Like "圖片*" Then sh.OnAction = "nn": dic(sh.Name & "h") = sh.Height: dic(sh.Name & "w") = sh.Width
  6. Next
  7. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 16# 317


    沒錯用Type做判斷是個可行的方法
學海無涯_不恥下問

TOP

        靜思自在 : 一個人的快樂.不是因為他擁有得多,而是因為他計較得少。
返回列表 上一主題