Board logo

標題: 一個放大圖片問題 [打印本頁]
作者: 317    時間: 2010-12-19 20:56     標題: 一個放大圖片問題

大大們, 好
小妹有一放大圖片問題, 懇請大大們協助, 現把檔案上傳, 內有明細說明, 謝謝!!
[attach]4144[/attach]
作者: Hsieh    時間: 2010-12-20 13:14

回復 1# 317

按一下放大，再按一下還原
   [attach]4151[/attach]
作者: 317    時間: 2010-12-20 21:36

hsieh大大,
謝謝大大解決小妹問題, 但有一小問題, 我原先工作表中在This Workbook有一小程式
Private Sub Workbook_Open()
UserForm1.Show
End Sub

Private Sub Workbook_Open()
Set dic = CreateObject("Scripting.Dictionary")
Dim sh As Shape
For Each sh In Sheet1.Shapes
   If sh.Name Like "Picture*" Then sh.OnAction = "nn": dic(sh.Name & "h") = sh.Height:: dic(sh.Name & "w") = sh.Width
Next
End Sub

两個程式中都用上Private Sub Workbook_Open()
如何把2個程式合併, 請大大指導, 謝謝!!
作者: Hsieh    時間: 2010-12-20 21:50

回復 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
複製代碼
作者: 317    時間: 2010-12-20 22:22

謝謝大大,
待明天把手上的工作表整理, 為新一年而努力, 感謝大大協助解,
新年快到, 祝願大大新春快樂, 萬事順景..
作者: 317    時間: 2010-12-21 13:33

回復 2# Hsieh
大大:午安
發現一個問題, 如果在檔案內插入新的圖片, 給予指定巨集, 理應是, 按一下放大, 再按一下回復原狀, 但當指定巨集後, 按一下, 圖片不見了, 是何原因, 或小妹程序上錯誤, 請大大協助, 謝謝!!
作者: Hsieh    時間: 2010-12-21 14:51

回復 6# 317


    插入圖片後存檔再開啟檔案測試看看
作者: 317    時間: 2010-12-22 10:00

hsieh大大,早晨
昨天因事往港, 今早才回到家中, 開機看到大大回覆, 即時試驗, 原來無須再指定巨集, 謝謝大大,
中國人常說, 冬大過年, 今天冬至, 祝願人月两全..
作者: 周大偉    時間: 2010-12-22 12:27

大大,
這個檔案很捧, 點繫一下放大, 點繫一下縮小, 小弟一直以為網頁才能做到這效果, 原來excel程式編寫也能做到這效果, 大大真捧, 但小弟有問題一問, 當點繫放大, 圖片能否設定左手面, 如能設定於左上角就更捧, 感恩
作者: Hsieh    時間: 2010-12-22 12:58

回復 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
複製代碼
[attach]4184[/attach]
作者: 周大偉    時間: 2010-12-22 13:32

hsieh大大:
大大真的很捧, 謝過..
作者: 317    時間: 2011-10-21 08:02

Hsieh版主大大,好
換了07excel, 程式沒法運行, 何解..
在03中是沒有問題存在, 請大大指導, 附件,
謝謝!!
[attach]8289[/attach]
作者: 317    時間: 2011-10-23 16:28

小妹真的希望能知道原因, 現再度整理檔案上傳, 望大大們能協助, 謝謝!!
[attach]8319[/attach]
作者: Hsieh    時間: 2011-10-23 16:40

本帖最後由 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
複製代碼
作者: oobird    時間: 2011-10-23 16:53

想不到2007有這樣的問題
若用 If sh.Type = 13 Then…呢？這樣還有問題嗎？
作者: 317    時間: 2011-10-23 17:13

衷心謝過两位版主大大,
祝願快樂, 感恩, 謝謝!!
作者: Hsieh    時間: 2011-10-23 17:17

回復 16# 317


    沒錯用Type做判斷是個可行的方法



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