[問題] EXCEL中有多個插入的CAD圖，如何查看插入CAD圖的容量？

EXCEL檔中有多個已插入的CAD圖，其中有部分CAD圖是異常的，正常的CAD圖大約100KB左右，異常的CAD圖大約6MB-8MB

目前需要做CAD瘦身，方法是在EXCEL中一個一個打開插入的CAD物件，執行PU指令，然後EXCEL重新存檔即可恢復正常檔案大小

問題是，這樣要把所有CAD物件全部開啟一次的處理速度太慢，每一個XLSX檔案裏面有10多個以上分頁，每個分頁有數個CAD物件(每個檔案平均都超過100個CAD物件)，要檢查的XLSX檔案超過5000個......  

請問，有什麼方式可以直接抓到CAD物件的容量大小，這樣可以針對容量異常的CAD檔開啟做PU指令修復 (重複的物件可以用VBA刪除再重新插入已修復的)，不用浪費時間全部做一輪PU

這個真是個大工程，可能得找看看有沒有適合的外掛！

一般我們不在EXCEL插入CAD圖...
有經驗的朋友幫忙回覆吧！

可以給個 sample 嗎 ?? excel 插入 dwg 不太會用........... 3Q

shackle_2005 寫到:可以給個 sample 嗎 ?? excel 插入 dwg 不太會用........... 3Q

跟插入圖片一樣，是把DWG檔案內嵌到EXCEL裡面當一個物件，會得到一個包裹著DWG的XLSX檔案

簡單的方法是開啟AUOCAD，在CAD裡面框選圖形範圍，複製，回到EXCEL裡面貼上 (要用EXCEL的插入物件指令也行，只是步驟沒這麼方便)

附件是簡單的樣板，裡面插入一張JPG，一個DWG，在DWG上點兩下就可以呼叫AUTOCAD修改內容

如果是CAD物件是從檔案建立並連結至檔案的話
有外掛是批量清除CAD檔
可參考關於AutoCAD DWG檔案異常容量變大-II的外掛程式

如果沒有連結至檔案或是直接從Excel建立CAD物件
就不適用這方法

我沒有完全了解你的問題, 但我想到的是用 VBA 寫一個自動程式把 CAD 圖檔全部 PU 一次就好了, 一點也不會費力. 寫這個 VBA 應該不困難, 參考一下...........

shackle_2005 寫到:我沒有完全了解你的問題, 但我想到的是用 VBA 寫一個自動程式把 CAD 圖檔全部 PU 一次就好了, 一點也不會費力. 寫這個 VBA 應該不困難, 參考一下...........

但不是每個人都會寫VBA
所以還是有難度

LuckeyFly 寫到:

shackle_2005 寫到:可以給個 sample 嗎 ?? excel 插入 dwg 不太會用........... 3Q

跟插入圖片一樣，是把DWG檔案內嵌到EXCEL裡面當一個物件，會得到一個包裹著DWG的XLSX檔案

簡單的方法是開啟AUOCAD，在CAD裡面框選圖形範圍，複製，回到EXCEL裡面貼上 (要用EXCEL的插入物件指令也行，只是步驟沒這麼方便)

附件是簡單的樣板，裡面插入一張JPG，一個DWG，在DWG上點兩下就可以呼叫AUTOCAD修改內容

原來還可以這樣子插入AUTOCAD檔案啊! 長知識了!
一直以來都用wmf模式

Option Explicit

Public tm As AcadModelSpace
Public tu As AcadUtility
Public pi  As Double

Public Sub auto_purge()

On Error Resume Next

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
pi = 3.141592 / 180

Dim fs As New FileSystemObject
Dim fd As Folder
Dim sfd As Folder
Dim my_path As String
Dim dwg_path As String
Dim f As File

my_path = "c:\"

' 指定路徑下搜尋 .dwg 檔
Set fd = fs.GetFolder(my_path)

For Each sfd In fd.SubFolders
   If InStr(sfd.Name, ".") = 0 Then
   
      For Each f In sfd.Files
          If InStr(f.Name, ".dwg") > 0 Then
         
             dwg_path = my_path & sfd.Name & "\" & f.Name
                           
             'MsgBox dwg_path
             
             ThisDrawing.Application.Documents.Open dwg_path
             ThisDrawing.PurgeAll: ThisDrawing.Save: ThisDrawing.Close
          End If
      Next
   End If
Next

End Sub

shackle_2005 寫到:Option Explicit

Public tm As AcadModelSpace
Public tu As AcadUtility
Public pi  As Double

Public Sub auto_purge()

On Error Resume Next

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
pi = 3.141592 / 180

Dim fs As New FileSystemObject
Dim fd As Folder
Dim sfd As Folder
Dim my_path As String
Dim dwg_path As String
Dim f As File

my_path = "c:\"

' 指定路徑下搜尋 .dwg 檔
Set fd = fs.GetFolder(my_path)

For Each sfd In fd.SubFolders
   If InStr(sfd.Name, ".") = 0 Then
   
      For Each f In sfd.Files
          If InStr(f.Name, ".dwg") > 0 Then
         
             dwg_path = my_path & sfd.Name & "\" & f.Name
                           
             'MsgBox dwg_path
             
             ThisDrawing.Application.Documents.Open dwg_path
             ThisDrawing.PurgeAll: ThisDrawing.Save: ThisDrawing.Close
          End If
      Next
   End If
Next

End Sub

感謝回復

我現在的問題是，DWG檔全部都已經內嵌在EXCEL裡面，也就是我只有XLSX檔案，我的處理目標是XLSX檔案裏面的內嵌OLE物件

這個VBA程式無法套用




目前找到的方法：(用7-ZIP解壓縮)
1. 用7-ZIP把XLSX檔案解壓縮到同名資料夾
2. 進入xl資料夾(裡面是所有的內嵌物件)、再進入embeddings資料夾(裡面是OLE類別的物件)
3. 看哪幾個 oleObject.bin 檔案容量異常大，用7-ZIP再次解壓縮到同名資料夾
4. 解壓縮oleObject.bin後會有三個檔案，把沒有副檔名的Contents 加上副檔名DWG，就可以用AUTOCAD開啟，執行PU
5. 全部完成，反向把檔案復原、壓縮、回到XLSX格式

judyyai 寫到:
原來還可以這樣子插入AUTOCAD檔案啊! 長知識了!
一直以來都用wmf模式

這種內嵌OLE物件的插入方式，最大優點就是插入後會打包變成一個檔案，不用理會原始檔案的路徑位置

要把檔案複製給別人的時候非常方便，對方收到檔案也可以自由開啟編輯OLE物件

文書類的軟體大多都支援

例如在PPT或WORD裡面插入EXCEL、在PDF裡面插入DWG...

LuckeyFly 寫到:

judyyai 寫到:
原來還可以這樣子插入AUTOCAD檔案啊! 長知識了!
一直以來都用wmf模式

這種內嵌OLE物件的插入方式，最大優點就是插入後會打包變成一個檔案，不用理會原始檔案的路徑位置

要把檔案複製給別人的時候非常方便，對方收到檔案也可以自由開啟編輯OLE物件

文書類的軟體大多都支援

例如在PPT或WORD裡面插入EXCEL、在PDF裡面插入DWG...

原來如此!謝謝指導與說明!

Option Explicit

Public tm As AcadModelSpace
Public tu As AcadUtility
Public pi  As Double
Public xlsheet As Excel.Worksheet
Public xlapp As Excel.Application
Public xlbook As Excel.Workbook

Public Sub test()

'On Error Resume Next

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
pi = 3.141592 / 180

excel_open

Dim ole As OLEObject

Set ole = xlsheet.OLEObjects.Item(1)



excel_close

End Sub

Private Sub excel_open()

Dim file_path As String

file_path = "d:\test.xlsx"
Set xlbook = GetObject(file_path)
Set xlapp = xlbook.Parent
Set xlsheet = xlbook.Sheets("Sheet1")

End Sub

Private Sub excel_close()

Set xlbook = Nothing
Set xlapp = Nothing
Set xlsheet = Nothing

End Sub

另一個想法是現在可以抓到每一個 sheet 的 oleobjects 數量( xlsheet.Oleobjects.Count ), cad 圖檔平均是 100 K, 所以可以計算全部檔案大小再來比對 xlsx 的大小. 或許這是一個方法, 參考一下

7-zip 資料夾裏面有一個 7-zip.chm 說明檔有解說. 另一個方法就是把 7-zip 手動作業全部用 VBA 自動化, 我測試好可以自動解出 OleObjects.bin 檔

Private Sub excel_7z_process()

Dim Tmp
 
Tmp = Shell("c:\7-zip\7z.exe e d:\test.xlsx -oc:\soft oleObject1.bin -r", vbNormalFocus)
   
   
'Tmp = Shell("C:\Progra~1\7-Zip\7z.EXE a -tzip C:\7ZIP_TEST.zip C:\CGM_7ZIP_TEST\*", vbNormalFocus)
'Tmp = Shell("C:\7-Zip\7z.exe e D:\test.xlsx c:\")
'Tmp = Shell("c:\7-zip\7z.exe e d:\test.xlsx -oc:\ *.cpp -r")
   '7z就是我們上面設定過的7z.exe
   'a是壓縮的意思
   'C:\7ZIP_TEST.zip表示我們壓縮完的壓縮檔命名為7ZIP_TEST壓縮格式是zip
   'C:\CGM_7ZIP_TEST\*表示目錄下的所有檔案來作為我們的壓縮列表

'MsgBox "OK"

End Sub

shackle_2005 寫到:7-zip 資料夾裏面有一個 7-zip.chm 說明檔有解說. 另一個方法就是把 7-zip 手動作業全部用 VBA 自動化, 我測試好可以自動解出 OleObjects.bin 檔

Private Sub excel_7z_process()

Dim Tmp
 
Tmp = Shell("c:\7-zip\7z.exe e d:\test.xlsx -oc:\soft oleObject1.bin -r", vbNormalFocus)
   
   
'Tmp = Shell("C:\Progra~1\7-Zip\7z.EXE a -tzip C:\7ZIP_TEST.zip C:\CGM_7ZIP_TEST\*", vbNormalFocus)
'Tmp = Shell("C:\7-Zip\7z.exe e D:\test.xlsx c:\")
'Tmp = Shell("c:\7-zip\7z.exe e d:\test.xlsx -oc:\ *.cpp -r")
   '7z就是我們上面設定過的7z.exe
   'a是壓縮的意思
   'C:\7ZIP_TEST.zip表示我們壓縮完的壓縮檔命名為7ZIP_TEST壓縮格式是zip
   'C:\CGM_7ZIP_TEST\*表示目錄下的所有檔案來作為我們的壓縮列表

'MsgBox "OK"

End Sub

感謝協助

初步測試可行

看說明，7-zip可以直接用批次檔作業，這樣應該可以批量執行解壓縮，一個一個修改好在批量全部壓縮回去，我在研究一下指令

理論上應該是可以做到全自動不用人工, 所有的 content 不管大小都轉成 dwg , 全部都 purge 完再壓縮回去. 參考一下, 加油................

TO  shackle_2005大

你的VBA指令遇到2個問題
1、執行中遇到 [DWG檔案損壞] 和 [某些資料夾路徑或檔名] 會自動跳出，跳出後就不知道是在哪裡中斷
2、會漏檔案 (請看圖片，整個資料夾漏了一個檔案沒處理到)



請問能否增加記錄功能，把PU完成的檔案名稱與路徑填入TXT檔，這樣遇到跳出時可以查閱TXT檔案知道是在哪裡跳出的

一般 ON ERROR RESUME NEXT 有開, 應該是不會中斷. 如果真的會中斷, 關掉 ON ERROR RESUME NEXT 就可以知道斷在那裏. 另外可以 IF ERR THEN 如果錯誤的話就跳過往下一筆, ELSE 沒有錯誤再 purge, 滑鼠游標移到程式指令的上面按 F1 就會另外出現英文說明. 我猜大概是這樣, 我沒有 sample 可以 test.