commondialog类在VBA中该怎么用（谢谢）
这是我从网上下载的一段代码“不需要打开文件可以把文件夹中的所有DWG插入到当前图形”，运行起来说 commondialog 没有定义，我该怎么解决，谢谢大家！Sub IntBlkByDirDwg()<BR>On Error GoTo Err_Control<BR>Dim BlkFile As Variant<BR>Dim i As Integer<BR>Dim InstPnt As Variant<BR>Dim BlkRefObj As AcadBlockReference<BR>Dim varCancel As Variant
BlkFile = GetDir("选择要插入图形所在的目录：", "*.dwg")
If IsArray(BlkFile) Then<BR> ThisDrawing.Utility.Prompt vbCrLf & " 你选定了" & Str(UBound(BlkFile) + 1) & "个图形"<BR> For i = 0 To UBound(BlkFile)<BR> <BR> InstPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & " 请选择图形 " & JustFileName(BlkFile(i)) & " 的插入点：")<BR> Set BlkRefObj = ThisDrawing.ModelSpace.InsertBlock(InstPnt, _<BR> BlkFile(i), 1#, 1#, 1#, 0#)<BR> Next
End If
Exit_Here:<BR> Exit Sub<BR>Err_Control:<BR> Select Case Err.Number<BR> Case -2147352567<BR> varCancel = ThisDrawing.GetVariable("LASTPROMPT")<BR> If InStr(1, varCancel, "*Cancel*") <> 0 And InStr(1, varCancel, "*取消*") <> 0 Then<BR> Err.Clear<BR> Resume Exit_Here<BR> Else<BR> Err.Clear<BR> Resume<BR> End If<BR> Case -2145320928<BR> Err.Clear<BR> Resume Exit_Here<BR> Case Else<BR> Resume Exit_Here<BR> End Select
End Sub
'返回指定目录下指定名称所有文件的函数<BR>Function GetFileListByPath(Path As String, FileName As String) As Variant
Dim s As String<BR> Dim sFiles() As String<BR> Dim i As Integer<BR> s = Dir(Path & FileName)<BR> If s <> "" Then<BR> ReDim sFiles(i) As String<BR> sFiles(i) = Path & s<BR> i = 1<BR> s = Dir()<BR> While s <> ""<BR> ReDim Preserve sFiles(i) As String<BR> sFiles(i) = Path & s<BR> i = i + 1<BR> s = Dir()<BR> Wend<BR> GetFileListByPath = sFiles<BR> End If
End Function
'选定目录的函数，使用了commonDialog类<BR>Public Function GetDir(DialogTitle As String, FileName As String) As Variant
Dim dlg As CommonDialog <FONT color=#f73809> <FONT face=黑体 size=2>问题就出在这里</FONT></FONT>
Dim Path As String<BR>Dim FileList As Variant
Set dlg = New CommonDialog<BR> dlg.DialogTitle = DialogTitle<BR> If dlg.Browse Then<BR> Path = dlg.Path<BR> If Path <> "" Then<BR> Path = Left$(Path, InStr(Path, vbNullChar) - 1)<BR> If Right$(Path, 1) <> "\" Then Path = Path & "\"<BR> FileList = GetFileListByPath(Path, "*.dwg")<BR> GetDir = FileList<BR> End If<BR> End If<BR>
End Function
'由文件全路径名称返回文件的函数<BR>Public Function JustFileName(FileName) As String<BR>On Error Resume Next<BR>Dim count As Integer<BR>For count = Len(FileName) - 1 To 1 Step -1<BR> If Mid(FileName, count, 1) = "\" Or Mid(FileName, count, 1) = "/" Then<BR> JustFileName = Right(FileName, Len(FileName) - count)<BR> Exit For<BR> End If<BR>Next<BR>End Function
<BR> 程序怎么这么熟悉，好象是我写的。<BR>呵呵，现在用CommonDialog已经过时了，用API吧，实用函数栏目下有 谢谢版主，本来就是在网上弄的一段嘛。谢谢你！！！ 感谢，原来这样了啊。
是这个么？http://www.mjtd.com/Functions/ArticleShow.asp?ArticleID=300
页:
[1]