一個放大圖片問題

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 261
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-24

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2010-12-20 13:14 | 只看該作者

回復 1# 317

按一下放大，再按一下還原

ShowPicture.zip (190.74 KB)

學海無涯_不恥下問

317

帖子: 248
主題: 55
精華: 0
積分: 334
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
註冊時間: 2010-7-24
最後登錄: 2023-2-2

3^#

發表於 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個程式合併, 請大大指導, 謝謝!!

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 261
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-24

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2010-12-20 21:50 | 只看該作者

回復 3# 317
直接合併不衝突阿

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
UserForm1.Show
End Sub

複製代碼

學海無涯_不恥下問

317

帖子: 248
主題: 55
精華: 0
積分: 334
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
註冊時間: 2010-7-24
最後登錄: 2023-2-2

5^#

發表於 2010-12-20 22:22 | 只看該作者

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

317

帖子: 248
主題: 55
精華: 0
積分: 334
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
註冊時間: 2010-7-24
最後登錄: 2023-2-2

6^#

發表於 2010-12-21 13:33 | 只看該作者

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

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 261
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-24

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2010-12-21 14:51 | 只看該作者

回復 6# 317

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

學海無涯_不恥下問

317

帖子: 248
主題: 55
精華: 0
積分: 334
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
註冊時間: 2010-7-24
最後登錄: 2023-2-2

8^#

發表於 2010-12-22 10:00 | 只看該作者

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

周大偉

帖子: 250
主題: 59
精華: 0
積分: 313
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 澳門
註冊時間: 2010-9-11
最後登錄: 2020-1-6

9^#

發表於 2010-12-22 12:27 | 只看該作者

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

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 261
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-24

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

10^#

發表於 2010-12-22 12:58 | 只看該作者

回復 9# 周大偉

放大顯示於A1儲存格

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

複製代碼

一般模組

Public dic
Sub nn()
With Sheet1.Shapes(Application.Caller)
If .Left = ActiveSheet.[A1].Left Then
.Top = dic(.Name)(0)
.Left = dic(.Name)(1)
.Height = dic(.Name)(2)
.Width = dic(.Name)(3)
Else
.Height = dic(.Name)(2) * 3
.Width = dic(.Name)(3) * 3
.Top = ActiveSheet.[A1].Top
.Left = ActiveSheet.[A1].Left
.ZOrder msoBringToFront
End If
End With
End Sub

複製代碼

ShowPicture.zip (196.18 KB)

學海無涯_不恥下問