cmo140497

中學生 Rank: 2

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2012-2-20 10:54 | 只看該作者

[分享] (已解決,感謝版主的指導)請問有關於註解放大圖片問題

本帖最後由 cmo140497 於 2012-2-20 17:34 編輯

Dear 各位先拜 :
小弟爬文發現不用巨集寫註解放大圖片的範例,這是怎麼做到的?

[attach]9665[/attach]

http://forum.twbts.com/viewthread.php?tid=5738

原來是註解格式,歹勢,未爬文即亂發文,如果要靠巨集的話,請問各位前輩,要如何指定A欄位的所有圖片自動加入有A欄位圖片的註解(有放大的效果)?謝謝!

自動入加註解插入圖片放大.rar (25.24 KB)

樓主熱帖

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

2^#

發表於 2012-2-20 13:20 | 只看該作者

回復 1# cmo140497
參考這篇

http://chijanzen.net/wp/?p=289

自動入加註解插入圖片放大.rar (51.32 KB)

學海無涯_不恥下問

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

3^#

發表於 2012-2-20 14:00 | 只看該作者

回復 1# cmo140497
工作表1 的事件程式碼

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Msg As Boolean, xlP As Shape
On Error Resume Next
Pictures("COPY").Delete
For Each xlP In Me.Shapes
If xlP.TopLeftCell.Address = Target.Address Then
Msg = True
Exit For
End If
Next
If Msg = False Then Exit Sub
Selection.Copy
With ActiveSheet.Pictures.Paste
.Select
.Name = "Copy"
.Formula = Target.Address
.Top = Target.Offset(1, 2).Top
.Left = Target.Offset(, 2).Left
.Height = Target.Height * 5
.Width = Target.Height * 5
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.ForeColor.SchemeColor = 64
.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End With
Target.Select
End Sub

複製代碼

TOP

cmo140497

中學生 Rank: 2

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

4^#

發表於 2012-2-20 17:31 | 只看該作者

回復 2# Hsieh

感謝版主的指導,這個網站先前小弟有花時間,下載各種範例來參考,沒想到這樣也可以拿來引用,不過看了之後,對小弟實在有點困難,不過仍感謝版主的指導,謝謝!

TOP

cmo140497

中學生 Rank: 2

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

5^#

發表於 2012-2-20 17:34 | 只看該作者

回復 3# GBKEE

感謝版主的指導,儲存格的放大效果真的不錯,十分感謝!

TOP

cmo140497

中學生 Rank: 2

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

6^#

發表於 2012-2-20 18:49 | 只看該作者

回復 3# GBKEE

Dear 版主 :
不好意思,又遇到一個小問題,為何小弟作了ActiveSheet.Copy,為了它只copy了sheet1可作放大作用一次,其它sheet並沒有相對著作copy,感謝!

GetSINF_test.rar (18.05 KB)

TOP

cmo140497

中學生 Rank: 2

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

7^#

發表於 2012-2-20 19:06 | 只看該作者

回復 5# cmo140497

Dear GB版主 :
再請教一下,這個程式可否改掛在THIS WORKBOOK上,小弟想讓每一SHEET都有這個功能,而不是只有SHEET1,不好意思,再麻煩您指正一下了!
小弟用ActiveSheet.Copy,它只是copy第一次,後面就不會了,

GetSINF_test.rar (18.05 KB)

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2012-2-21 08:37 | 只看該作者

回復 7# cmo140497
ThisWorkbook模組的事件程式

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim Msg As Boolean, xlP As Shape
On Error Resume Next
Sh.Pictures("COPY").Delete
For Each xlP In Sh.Shapes
If xlP.TopLeftCell.Address = Target.Address Then
Msg = True
Exit For
End If
Next
If Msg = False Then Exit Sub
Selection.Copy
With ActiveSheet.Pictures.Paste
.Select
.Name = "Copy"
.Formula = Target.Address
.Top = Target.Offset(1, 2).Top
.Left = Target.Offset(, 2).Left
.Height = Target.Height * 5
.Width = Target.Height * 5
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.ForeColor.SchemeColor = 64
.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End With
Target.Select
End Sub

複製代碼

TOP

cmo140497

中學生 Rank: 2

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

9^#

發表於 2012-2-21 12:56 | 只看該作者

回復 8# GBKEE

感謝版主,昨天小弟一直在試workbook及worksheet,真不知workbook還可以串Sheetselectionchange,這一次真的受益匪淺,感謝!

TOP