返回列表 上一主題 發帖

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

cmo140497

帖子
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

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

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

帖子
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 的事件程式碼
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim Msg As Boolean, xlP  As Shape
  3.     On Error Resume Next
  4.     Pictures("COPY").Delete
  5.     For Each xlP In Me.Shapes
  6.         If xlP.TopLeftCell.Address = Target.Address Then
  7.             Msg = True
  8.             Exit For
  9.         End If
  10.     Next
  11.     If Msg = False Then Exit Sub
  12.     Selection.Copy
  13.     With ActiveSheet.Pictures.Paste
  14.         .Select
  15.         .Name = "Copy"
  16.         .Formula = Target.Address
  17.         .Top = Target.Offset(1, 2).Top
  18.         .Left = Target.Offset(, 2).Left
  19.         .Height = Target.Height * 5
  20.         .Width = Target.Height * 5
  21.         .ShapeRange.Line.Visible = msoTrue
  22.         .ShapeRange.Line.ForeColor.SchemeColor = 64
  23.         .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
  24.     End With
  25.     Target.Select
  26. End Sub
複製代碼

TOP

cmo140497

帖子
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

帖子
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

帖子
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

帖子
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

帖子
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模組的事件程式
  1. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  2.     Dim Msg As Boolean, xlP  As Shape
  3.     On Error Resume Next
  4.     Sh.Pictures("COPY").Delete
  5.     For Each xlP In Sh.Shapes
  6.         If xlP.TopLeftCell.Address = Target.Address Then
  7.             Msg = True
  8.             Exit For
  9.         End If
  10.     Next
  11.     If Msg = False Then Exit Sub
  12.     Selection.Copy
  13.     With ActiveSheet.Pictures.Paste
  14.         .Select
  15.         .Name = "Copy"
  16.         .Formula = Target.Address
  17.         .Top = Target.Offset(1, 2).Top
  18.         .Left = Target.Offset(, 2).Left
  19.         .Height = Target.Height * 5
  20.         .Width = Target.Height * 5
  21.         .ShapeRange.Line.Visible = msoTrue
  22.         .ShapeRange.Line.ForeColor.SchemeColor = 64
  23.         .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
  24.     End With
  25.     Target.Select
  26. End Sub
複製代碼

TOP

cmo140497

帖子
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

        靜思自在 : 愛不是要求對方，而是要由自身的付出。
返回列表 上一主題