返回目录:office365
选择工作百表标签,右击--查看代码,双度击"thisworkbook"标签,将下面的代码知拷入代码框内,关闭代道码框就行了。
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Target.Activate
ActiveSheet.Pictures.Insert("C:\11.gif").Select
End Sub
可以用vba代码完成:
1、先编制表格:
2、在表格里编写触发宏代码:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim photoname As String
If Target.Row = 3 And Target.Column > 3 And Target.Column < 6 Then
On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each shp In Sheets("查询表").Shapes
If shp.Type <> 8 And shp.Type <> 12 Then
shp.Delete
End If
Next
photoname = Cells(3, 4) & ".JPG"
Cells(3, "L").Select
ActiveSheet.Pictures.Insert(ActiveWorkbook.Path & "\照片\" & photoname).Select '当前文件所在目录下以单元内容为名称的.jpg图片
With Selection
ta = Range(Cells(3, "L").MergeArea.Address).Height '单元高度
tb = Range(Cells(3, "L").MergeArea.Address).Width '单元宽度
tc = .Height '图片高度
td = .Width '图片宽度
tm = Application.WorksheetFunction.Min(ta / tc, tb / td) '单元与图片之间长宽差异比e79fa5e98193e58685e5aeb9366例的最小值
.Top = ActiveCell.Top + 2
.Left = ActiveCell.Left + 1
.Height = .Height * tm * 0.98 '按比例调整图片宽度
.Width = .Width * tm * 0.98 '按比例调整图片高度
End With
Cells(3, 4).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
3、在当前目录下建个名为”照片“的子目录,里面存有以姓名为名称的.jpg格式的照片
4、在姓名后单元输入姓名后,就能自动插入图片了
下面的代码实复现A1到An:
Sub test()
Dim i As Integer
i = 1
Do While True
If InStr(Range("A1") & i, "y") > 0 Or i = 100 Then Exit Do
If InStr(Range("A" & i), "x") > 0 Then
Rows(i).Delete
Else
i = i + 1
End If
Loop
End Sub
x、制y、100就是你的zhidaoX、Y、N,请自己修改。
首先,宏功能zdwps默认没有,需要单独安装,建议使用微软的office。
你说的功能可以实现专,可以在excelhome论坛里搜索。
Sub movepic()
Sheet1.Shapes(1).Left = [B2].Left '图片的左侧即B2左侧
Sheet1.Shapes(1).Top = [B2].Top '图片的顶属部即B2顶部
End Sub