将下面代码放到当前VBA中当前工作表名称下的代码窗口中,保存,即可。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r
Dim mydir, mypath
Application.ScreenUpdating = False
On Error GoTo err
mypath = ThisWorkbook.Path & "\员工档案\" '取得存放Word文件的地址为:当前文件所在文件夹下的“员工档案”文件夹下
If Target.Column = 2 And Target.Row > 2 Then '指在第二列,第二行以下(可根据实际姓名所在列改变列数,及姓名开始的行数)
r = Target.Cells.Value '取得当前输入的姓名
' MsgBox r
mydir = Dir(mypath & r & ".docx", vbNormal) '用当前输入姓名为Word文件名到指定文件夹下查找。
'若Office用的是2003版,则为Doc,2007版和2010版为Docx
If mydir = "" Then
Set wd = CreateObject("word.application")
Set doc = CreateObject("word.document")
wd.Visible = True
Set doc = wd.Application.documents.Add
doc.SaveAs mypath & r '如果未找到刚输入姓名的文件,则创建该文件
doc.Save
doc.Close
Set doc = Nothing
wd.Quit
Set wd = Nothing
Target.Cells.Hyperlinks.Add _
anchor:=Target.Cells, Address:=mypath & r & ".docx" '在输入的名字下创建超链接为mypath下以当前名字为名称的文件
Else
Target.Cells.Hyperlinks.Add _
anchor:=Target.Cells, Address:=mypath & r & ".docx"
End If
End If
err:
Application.ScreenUpdating = True
End Sub
有不明白的地方,Hi上留言。