设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 2355|回复: 2
打印 上一主题 下一主题

(以解決)批註插入圖片的宏可否增加圖片連接單獨打開圖片

[复制链接]
跳转到指定楼层
1#
发表于 2011-6-15 03:25:41 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 joyark 于 2011-6-15 12:55 编辑

批註插入圖片的宏可否增加圖片連接單獨打開圖片
希望各位幫忙寫出相關的宏
問題1.批註插入圖片的宏
    2.圖片插入後,能否加上超連結打開圖片的宏
      謝謝各位幫忙


'批註插入圖片的宏
Option Explicit
Const ImgFileFormat = "Image Files (*.bmp;*.gif;*.tif;*.jpg;*.jpeg)," & _
"*bmp;*gif;*.tif;*.jpg;*.jpeg"

'--------------------------------------------------------------------------------
Sub AddPicturesToComments() '插入备注图片
Dim HasCom
Dim Pict As String
Dim ans As Integer
Set HasCom = ActiveCell.Comment
If Not HasCom Is Nothing Then ActiveCell.Comment.Delete
Set HasCom = Nothing
GetPict:
Pict = Application.GetOpenFilename(ImgFileFormat)
If Pict = "False" Then End
ans = MsgBox("Open : " & Pict, vbYesNo + vbExclamation, "Use this Picture?")
If ans = vbNo Then GoTo GetPict
With ActiveCell
.AddComment
.Comment.Visible = False
.Comment.Shape.Fill.Transparency = 0#
.Comment.Shape.Fill.UserPicture Pict
End With
ActiveCell.Select
ActiveCell.Comment.Shape.ScaleWidth 3, msoFalse, msoScaleFromTopLeft
ActiveCell.Comment.Shape.ScaleHeight 4, msoFalse, msoScaleFromTopLeft
ActiveSheet.Hyperlinks.Add ActiveCell, Pict, , , Pict
End Sub

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享1 分享淘帖 订阅订阅
2#
发表于 2011-6-15 10:01:51 | 只看该作者
在最后一句加上这一句看看?
ActiveSheet .Hyperlinks.Add ActiveCell, Pict, , , Pict
在2010版本测试没问题。
3#
 楼主| 发表于 2011-6-15 12:52:55 | 只看该作者
謝謝幫忙
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-4-29 16:14 , Processed in 0.087985 second(s), 26 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表