一個放大圖片問題

317

大大們, 好
小妹有一放大圖片問題, 懇請大大們協助, 現把檔案上傳, 內有明細說明, 謝謝!!
Book1.rar (181.08 KB)

下載次數: 19

2010-12-19 20:56

Hsieh

回復 1# 317

按一下放大，再按一下還原
    ShowPicture.zip (190.74 KB)

下載次數: 68

2010-12-20 13:14

317

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

回復 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

謝謝大大,
待明天把手上的工作表整理, 為新一年而努力, 感謝大大協助解,
新年快到, 祝願大大新春快樂, 萬事順景..

317

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

Hsieh

回復 6# 317


    插入圖片後存檔再開啟檔案測試看看

317

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

周大偉

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

Hsieh

回復 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)

下載次數: 40

2010-12-22 12:58