如何用VBA批量更换打印模型中的打印机名称？

sanjie

我有很多的CAD图纸，用的都是HP LaserJet 8100 Series PCL的打印机，现在打印机换成了HP LaserJet 5100 PCL 6，该如何用VBA批量把D:\cad\下图纸的打印机由HP LaserJet 8100 Series PCL更改为HP LaserJet 5100 PCL 6，我不想手动一个个修改了，请高手解决！

sanjie

我知道用VBA for Excel可以！相信用CAD也可以！请高手解答！

sanjie

我可以用以下代码批量打开Excel，但不知该如何批量打开CAD，

2. Sub xiugai()
3. Application.ScreenUpdating = False
4. With Application.FileSearch
5. .LookIn = "D:\new"
6. .FileType = msoFileTypeExcelWorkbooks
7. .SearchSubFolders = True
8. If .Execute > 0 Then
9. For i = 1 To .FoundFiles.Count
10. Workbooks.Open Filename:=.FoundFiles(i)
11. Worksheets("10KV1").Select
12. Range("D65").Value = 0
13. Range("D66").Value = 0
14. Range("D67").Value = 0
15. Range("D78").Value = 0
16. Range("D79").Value = 0
17. Range("D133").Value = 0
18. ActiveWorkbook.Close savechanges:=True
19. Next i
20. Else
21. MsgBox "没有找到任何工作簿文件"
22. End If
23. End With
24. Application.ScreenUpdating = True
25. End Sub

Sub xiugai() Application.ScreenUpdating = False With Application.FileSearch .LookIn = "D:\new" .FileType = msoFileTypeExcelWorkbooks .SearchSubFolders = True If .Execute > 0 Then For i = 1 To .FoundFiles.Count Workbooks.Open Filename:=.FoundFiles(i) Worksheets("10KV1").Select Range("D65").Value = 0 Range("D66").Value = 0 Range("D67").Value = 0 Range("D78").Value = 0 Range("D79").Value = 0 Range("D133").Value = 0 ActiveWorkbook.Close savechanges:=True Next i Else MsgBox "没有找到任何工作簿文件" End If End With Application.ScreenUpdating = True End Sub

sanjie

论坛这么冷清...............

alin

;; The following code change the default modelspace printer
;; for all the drawings in the path "H:\" to "DWF6 ePlot.pc3"
;; Author: Unknown

2. Option Explicit
3. Sub BatchChangePrinter()
4. Dim files() As String
5. Dim file_name As String
6. Dim dir_path As String
7. Dim num_files, a As Long
8. dir_path = "H:\*.dwg"
9. file_name = Dir$(dir_path)
10. Do While Len(file_name) > 0
11.     If Not (file_name = ".") Or (file_name = "..") Then
12.         num_files = num_files + 1
13.         ReDim Preserve files(1 To num_files)
14.         files(num_files) = Left(dir_path, Len(dir_path) - 5) & file_name
15.     End If
16.     file_name = Dir$()
17. Loop
18. For a = LBound(files) To UBound(files)
19.     Dim doc As AcadDocument
20.     Dim model As AcadLayout
21.      Set doc = ThisDrawing.Application.Documents.Open(files(a))
22.      Set model = doc.Layouts("Model")
23.      model.RefreshPlotDeviceInfo
24.      model.ConfigName = "DWF6 ePlot.pc3"
25.      doc.Close (True)
26. Next
27. End Sub

Option Explicit Sub BatchChangePrinter() Dim files() As String Dim file_name As String Dim dir_path As String Dim num_files, a As Long dir_path = "H:\*.dwg" file_name = Dir$(dir_path) Do While Len(file_name) > 0     If Not (file_name = ".") Or (file_name = "..") Then         num_files = num_files + 1         ReDim Preserve files(1 To num_files)         files(num_files) = Left(dir_path, Len(dir_path) - 5) & file_name     End If     file_name = Dir$() Loop For a = LBound(files) To UBound(files)     Dim doc As AcadDocument     Dim model As AcadLayout      Set doc = ThisDrawing.Application.Documents.Open(files(a))      Set model = doc.Layouts("Model")      model.RefreshPlotDeviceInfo      model.ConfigName = "DWF6 ePlot.pc3"      doc.Close (True) Next End Sub

mccad

http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=669