Sub 批量插入同名照片到批注() Dim cell As Range, fd, t Selection.ClearComments If Selection(1) = "" Then MsgBox "不能选择空白区。", 64, "提示": Exit Sub On Error GoTo err Set fd = Application.FileDialog(msoFileDialogFolderPicker) '允许用户选择一个文件夹 If fd.Show = -1 Then t = fd.SelectedItems(1) '选择之后就记录这个文件夹名称 Else Exit Sub '否则就退出程序 End If For Each cell In Selection With cell.AddComment .Visible = True .Text Text:="" .Shape.Select True Selection.ShapeRange.Fill.UserPicture t & "\" & cell.Text & ".jpg" cell.Offset(1, 0).Select .Visible = False End With Next Exit Sub err: ActiveCell.ClearComments MsgBox "未找到同名的JPG图片!", 64, "提示" End Sub
[此贴子已经被作者于2008-2-11 9:05:39编辑过]
[ 本帖最后由 andysky 于 2009-8-14 16:59 编辑 ] |