从 excel 中提取时出现编译错误

Compile error occurs when extracting from excel

我正在尝试使用 VBA 脚本来 运行 3D cad 程序 SolidWorks 的渲染列表。
我在 MS Excel 中列出了 B 列中的文件名及其 A 列中的文件扩展名

渲染部分工作正常,但现在我在以下位置遇到错误:

   Dim xlApp As Excel.Application

发生的错误显示消息:Compile error: User-defined type not defined.

您可以在下面找到代码:

Sub main()
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim status As Boolean
Set swApp = Application.SldWorks
Dim i As String
Dim j As String
Dim y As Integer
Dim n As Integer
Dim m As Integer
Dim swModel As SldWorks.ModelDoc2
Dim swRayTraceRenderer As SldWorks.RayTraceRenderer
Dim swRayTraceRenderOptions As SldWorks.RayTraceRendererOptions
Dim errors As Long
Dim warnings As Long
Dim filePath As String

'i = file name
'j = file extention

'i = "bp01p0006" example
'j = "simbeton - Solidworks\bp - betonplaten\bp01 - simvlak\" example

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
 Set xlApp = New Excel.Application

'Set xlWB = xlApp.Workbooks.Open(“C:\Users\Omar\Desktop\Renders Rob\Lijst.xlsx”)
Set xlWB = xlApp.Workbooks.Open(“Lijst.xlsx”)

y = 0


n = 0

Do While n < 5
    If xlWB.Worksheets(1).Range("A1").offset(y, 0) = "" Then
        y = y + 1
        n = n + 1
        Else
            j = xlWB.Worksheets(1).Range("A1").offset(y, 0).Value
            i = xlWB.Worksheets(1).Range("A1").offset(y, 1).Value
            xlWB.Worksheets(1).Range("A1").offset(y, 0) = ""
            y = y + 1
    End If



   Set xlWB = Nothing
Set xlApp = Nothing


filePath = "Z:\" & j & "" & i & ".SLDPRT"
Set swModel = swApp.OpenDoc6(filePath, swDocPART, swOpenDocOptions_Silent, "", errors, warnings)

Set swApp = _
Application.SldWorks

Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.AddPerspective
Part.ViewZoomtofit2
Part.ViewZoomtofit2
Part.ViewZoomtofit2
Part.ViewZoomtofit2
Part.ViewZoomtofit2
Part.ShowNamedView2 "*Isometric", 7
Part.ViewZoomtofit2

Part.ViewDisplayShaded
Dim activeModelView As Object
Set activeModelView = Part.ActiveView
activeModelView.DisplayMode = swViewDisplayMode_e.swViewDisplayMode_ShadedWithEdges
Part.ClearSelection2 True
boolstatus = Part.Extension.SketchBoxSelect("0.000000", "0.000000", "0.000000", "0.000000", "0.000000", "0.000000")
Part.ViewDisplayShaded

' Access PhotoView 360
Set swRayTraceRenderer = swApp.GetRayTraceRenderer(swPhotoView)
' Get and set rendering options
Set swRayTraceRenderOptions = swRayTraceRenderer.RayTraceRendererOptions
'Get current rendering values
Debug.Print "Current rendering values"
Debug.Print "  ImageHeight          = " & swRayTraceRenderOptions.ImageHeight
Debug.Print "  ImageWidth           = " & swRayTraceRenderOptions.ImageWidth
Debug.Print "  ImageFormat          = " & swRayTraceRenderOptions.ImageFormat
Debug.Print "  PreviewRenderQuality = " & swRayTraceRenderOptions.PreviewRenderQuality
Debug.Print "  FinalRenderQuality   = " & swRayTraceRenderOptions.FinalRenderQuality
Debug.Print "  BloomEnabled         = " & swRayTraceRenderOptions.BloomEnabled
Debug.Print "  BloomThreshold       = " & swRayTraceRenderOptions.BloomThreshold
Debug.Print "  BloomRadius          = " & swRayTraceRenderOptions.BloomRadius
Debug.Print "  ContourEnabled       = " & swRayTraceRenderOptions.ContourEnabled
Debug.Print "  ShadedContour        = " & swRayTraceRenderOptions.ShadedContour
Debug.Print "  ContourLineThickness = " & swRayTraceRenderOptions.ContourLineThickness
Debug.Print "  ContourLineColor     = " & swRayTraceRenderOptions.ContourLineColor
Debug.Print " "
' Change rendering values
Debug.Print "New rendering values"
swRayTraceRenderOptions.ImageHeight = 720
Debug.Print "  ImageHeight          = " & swRayTraceRenderOptions.ImageHeight
swRayTraceRenderOptions.ImageWidth = 405
Debug.Print "  ImageWidth           = " & swRayTraceRenderOptions.ImageWidth
swRayTraceRenderOptions.ImageFormat = swImageFormat_PNG
Debug.Print "  ImageFormat          = " & swRayTraceRenderOptions.ImageFormat
swRayTraceRenderOptions.PreviewRenderQuality = swRenderQuality_Better
Debug.Print "  PreviewRenderQuality = " & swRayTraceRenderOptions.PreviewRenderQuality
swRayTraceRenderOptions.FinalRenderQuality = swRenderQuality_Best
Debug.Print "  FinalRenderQuality   = " & swRayTraceRenderOptions.FinalRenderQuality
swRayTraceRenderOptions.BloomEnabled = False
Debug.Print "  BloomEnabled         = " & swRayTraceRenderOptions.BloomEnabled
swRayTraceRenderOptions.BloomThreshold = 0
Debug.Print "  BloomThreshold       = " & swRayTraceRenderOptions.BloomThreshold
swRayTraceRenderOptions.BloomRadius = 0
Debug.Print "  BloomRadius          = " & swRayTraceRenderOptions.BloomRadius
swRayTraceRenderOptions.ContourEnabled = False
Debug.Print "  ContourEnabled       = " & swRayTraceRenderOptions.ContourEnabled
swRayTraceRenderOptions.ShadedContour = False
Debug.Print "  ShadedContour        = " & swRayTraceRenderOptions.ShadedContour
swRayTraceRenderOptions.ContourLineThickness = 0
Debug.Print "  ContourLineThickness = " & swRayTraceRenderOptions.ContourLineThickness
swRayTraceRenderOptions.ContourLineColor = 255
Debug.Print "  ContourLineColor     = " & swRayTraceRenderOptions.ContourLineColor
' Display the preview window
status = swRayTraceRenderer.DisplayPreviewWindow
' Close render
status = swRayTraceRenderer.CloseRayTraceRender
' Invoke final render window
status = swRayTraceRenderer.InvokeFinalRender
' Abort final render window
status = swRayTraceRenderer.AbortFinalRender
' Render to Windows Bitmap format
status = swRayTraceRenderer.RenderToFile("C:\Users\Omar\Desktop\Renders Rob\" & i & ".png", 0, 0)
swRayTraceRenderOptions.FinalRenderQuality = swRenderQuality_Good
' Render to HDR format (format extension omitted)
status = swRayTraceRenderer.RenderToFile("C:\Users\Omar\Desktop\Renders Rob\" & i, 0, 0)
Set swRayTraceRenderOptions = Nothing
' Close render
status = swRayTraceRenderer.CloseRayTraceRender

swApp.QuitDoc i

Loop

End Sub

为什么会发生这种情况,我该如何解决?

您正在使用 "Early Binding" 到 Excel 对象模型,那么您一定缺少 Excel 库引用

在您的 VBE 编辑器中打开 "References" 对话框(在 Excel VBE 中,这是在工具 -> 参考下,SolidWorks VBA IDE 可能是类似的),滚动列表框向下到 "Microsoft Excel XX.0 Library"("XX" 是 Excel 版本号)条目,选中它的复选框并单击确定。

或者您可能想使用 "Late Binding":

Dim xlApp As Object, xlWB As Object
Set xlApp = CreateObject("Excel.Application")

其中:

  • 您没有遇到任何 Excel versioning 问题

  • 但是你失去了 Intellisense

    因此您必须非常了解 Excel 对象模型才能正确使用其对象和相应的方法或属性

    但在您的情况下,您只使用 Workbooks 对象的 Open() 方法,Worksheet 对象的 Range 属性,因此 Range对象Offset()方法和Value属性,所以你已经完成了。