从 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
属性,所以你已经完成了。
我正在尝试使用 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
属性,所以你已经完成了。