自己做的一个acad中打开其他文件的宏vba

schooner · 发表于 2006-6-22 10:40:27

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

添加个窗体,在窗体上添加几个控件可
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Function FindFiles(path As String, SearchStr As String, _
   FileCount As Integer, DirCount As Integer)
   Dim FileName As String ' Walking filename variable.
   Dim DirName As String ' SubDirectory Name.
   Dim dirNames() As String ' Buffer for directory name entries.
   Dim nDir As Integer    ' Number of directories in this path.
   Dim i As Integer       ' For-loop counter.

   On Error GoTo sysFileERR
   If Right(path, 1) <> "\" Then path = path & "\"
   ' Search for subdirectories.
   nDir = 0
   ReDim dirNames(nDir)
   DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
Or vbSystem)  ' Even if hidden, and so on.
   Do While Len(DirName) > 0
      ' Ignore the current and encompassing directories.
      If (DirName <> ".") And (DirName <> "..") Then
         ' Check for directory with bitwise comparison.
         If GetAttr(path & DirName) And vbDirectory Then
            dirNames(nDir) = DirName
            DirCount = DirCount + 1
            nDir = nDir + 1
            ReDim Preserve dirNames(nDir)
            'listbox2.AddItem path & DirName ' Uncomment to listbox
         End If                         ' directories.
sysFileERRCont:
      End If
      DirName = Dir()  ' Get next subdirectory.
   Loop

   ' Search through this directory and sum file sizes.
   FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _
   Or vbReadOnly Or vbArchive)
   While Len(FileName) <> 0
      FindFiles = FindFiles + FileLen(path & FileName)
      FileCount = FileCount + 1
      ' Load listbox box
      ListBox2.AddItem path & FileName '& vbTab & _
         'FileDateTime(path & FileName) ' Include Modified Date
      FileName = Dir()  ' Get next file.
   Wend

   ' If there are sub-directories..
   If nDir > 0 Then
      ' Recursively walk into them
      For i = 0 To nDir - 1
         FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", _
         SearchStr, FileCount, DirCount)
      Next i
   End If

AbortFunction:
   Exit Function
sysFileERR:
   If Right(DirName, 4) = ".sys" Then
      Resume sysFileERRCont ' Known issue with pagefile.sys
   Else
      MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
      "Unexpected Error"
      Resume AbortFunction
   End If
   End Function

Private Sub CommandButton1_Click()
SearchForm.Hide
End Sub

   Private Sub Commandbutton2_Click()
   Dim SearchPath As String, FindStr As String
   Dim FileSize As Long
   Dim NumFiles As Integer, NumDirs As Integer

   'Screen.MousePointer = vbHourglass
   ListBox2.Clear
   SearchPath = TextBox1.Text
   FindStr = "*" & TextBox2.Text & "*" & TextBox3.Text
   FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)
   TextBox5.Text = NumFiles & " Files found in " & NumDirs + 1 & _
   " Directories"
   'textbox6.Text = "Size of files found under " & SearchPath & " = " & _
   'Format(FileSize, "#,###,###,##0") & " Bytes"
   'Screen.MousePointer = vbDefault
   If ListBox2.ListCount = 1 Then ListBox2_Click
   End Sub

Private Sub ListBox2_Click()
Dim strfilename As String
If ListBox2.ListCount >= 1 Then
'如果没有选中的内容，用上一次的列表项。
If ListBox2.ListIndex = -1 Then
      ListBox2.ListIndex = _
            ListBox2.ListCount - 1
End If
strfilename = ListBox2.List(ListBox2.ListIndex)

ShellExecute Application.hwnd, "open", strfilename, _
vbNullString, vbNullString, 3
End If

End Sub

Public Sub Start(ByVal strfilename As String, ByVal searchfolder As String)
Dim sel
Dim fs
CommandButton2.Caption = "SEARCH"
'MsgBox (strfilename)
strfilename = Strings.Left(strfilename, 8) '取前八位
TextBox1.Text = searchfolder
TextBox2.Text = strfilename
SearchForm.Show vbModeless

If Strings.Left(strfilename, 2) <> "17" And Strings.Left(strfilename, 2) <> "H7" And Strings.Left(strfilename, 1) <> "S" Then
MsgBox ("Not drawings No.")

Exit Sub
End If

   'CommandButton1.Caption = "Use API code"

   ' start with some reasonable defaults
   Commandbutton2_Click
End Sub

schooner · 发表于 2006-6-22 10:41:49

为了方便打开图纸中零部件的图纸而做的

schooner · 发表于 2006-6-22 11:19:05

需要什么条件,水能说一下?还要什么等级么,我看了帮助也没搞明白

Michael527 · 发表于 2006-6-22 13:09:47

提示: 作者被禁止或删除内容自动屏蔽

schooner · 发表于 2006-6-23 08:32:55

在看装配图的时候经常需要打开明细栏内的零件图看一下，结果要到windows里查找打开,很繁琐。
后来狠狠心做了这个宏，操作时运行宏，选择需要打开的零部件图号-文本，可多选。然后宏开始在特定目录中查找，如果只找到一个文件直接打开，如果找到多个就在list表内显示供选择，单击打开。
用的时候可以修改查找的目录，图号的规则
我写的时候目录为“x:”,我公司图号都是17或者H7或s等开头，查找前首先判断选择的文本是否是图号的文本，以防误选而耽误时间。
另，这个vba也可以在excel表内使用，是个通用的
当在excel内查看部品明细时，也是类似操作。

		自动登录	找回密码
密码			注册

通知

[分享] 自己做的一个acad中打开其他文件的宏vba

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

如有要得,可以发个dvb文件

我想把东西贴到帖子里

哦，忘记说明一下

浏览过的版块

Michael527 Michael527 当前离线积分 505 UID 123119 主题在线时间小时注册时间 2006-2-18 头像被屏蔽	发表于 2006-6-22 13:09:47 \| 显示全部楼层来自：中国四川眉山提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对举报