Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.DisplayAlerts = False
If Not Application.Intersect(Target, Range("C3")) Is Nothing Then Call 制定项目章程
If Not Application.Intersect(Target, Range("D3")) Is Nothing Then Call 制定项目管理计划
If Not Application.Intersect(Target, Range("E3")) Is Nothing Then Call 指导与管理项目工作
If Not Application.Intersect(Target, Range("E4")) Is Nothing Then Call 管理项目知识
If Target.Column = 11 Then
If Target.Row > 2 And Target.Row < 13 Then GetFileList Target
End If
Application.DisplayAlerts = True
Cancel = True
End Sub
Function GetFileList(ByVal Target As Range)
Dim strBasicPath As String, strSelFolder As String, strFileType As String
Dim strFileName As String, lngID As Long
Dim strFullName As String, rgResult As Range
If Trim(Target.Value) = "" Then Exit Function
'C:\Users\DCT\Desktop\PMP项目管理\示例项目\指定项目章程\组织过程资产
strBasicPath = ThisWorkbook.Path & "\指定项目章程"
strSelFolder = Trim(Target.Value) & ""
strFileType = "*.xlsx"
Set rgResult = Range("I15")
rgResult.Resize(100, 4).Clear
strFullName = strBasicPath & strSelFolder & strFileType
lngID = 0
strFileName = Dir(strFullName)
Do Until strFileName = ""
rgResult.Offset(lngID, 0).Value = lngID + 1
rgResult.Offset(lngID, 1).Value = strFileName
lngID = lngID + 1
strFileName = Dir()
Loop
End Function
***************************
Sub test()
mypath = "C:\Users\DCT\Desktop\PMP项目管理\示例项目\指定项目章程\组织过程资产" '路径最后务必以\结尾
Dim StrFile As String
StrFile = Dir(mypath)
Do While Len(StrFile) > 0
MsgBox StrFile
StrFile = Dir
Loop
End Sub
