返回列表 上一主題 發帖

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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

        靜思自在 : 【時間無法遮擋】怕時間消逝，花了許多心血，想盡各式方法要遮擋時間，結果是：浪費了更多時間，且一無所成！
返回列表 上一主題