|
马上注册,结交更多同行朋友,交流,分享,学习。
您需要 登录 才可以下载或查看,没有帐号?注册
x
本帖最后由 MALAI 于 2018-6-5 14:15 编辑
工程图中,有一个表,想通过VBA 将表格另存为EXCEL 的 .xls格式;
文件名= 当前文件名.XLS;
保存位置=当前工程图所在文件夹;打开对应的.XLS 文件;
说明:表格有可能是 孔表,也有可能是材料明细表,
以下代码是在论坛中找到的,
手动选中表格,执行宏,在相同的文件夹中另存成为TXT文件 (如果能把手动选中表格忽略那更好)
如果要改成 XLS
对应代码应该怎么改
我 怀疑是 改这个 SaveAText,
value = swTableAnnotation.SaveAsText(FileName, Separator) '表格另存为TXT文件
' ****************
' BOM TO TEXT
' ****************
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swTableAnnotation As SldWorks.TableAnnotation
Dim FileName As String
Dim Separator As String
Dim value As Boolean
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc '
If Part Is Nothing Then Exit Sub
PathName = Part.GetPathName '读取当前SW文档名(含路径)
FileName = Left(PathName, Len(PathName) - 7) + ".txt" '提取当前SW文件名加后缀名
Set swSelMgr = Part.SelectionManager '设选择器
Debug.Print swSelMgr.GetSelectedObjectCount
Debug.Print swSelMgr.GetSelectedObjectType(1)
If (swSelMgr.GetSelectedObjectCount = 0 Or Not (swSelMgr.GetSelectedObjectType(1) = swSelANNOTATIONTABLES)) Then
MsgBox "请在视图中选择BOM表格"
Exit Sub
End If
Set swTableAnnotation = swSelMgr.GetSelectedObject6(1, -1) '选择为表格
value = swTableAnnotation.SaveAsText(FileName, Separator) '表格另存为TXT文件 我 怀疑是 改这个 SaveAText,
If value Then
MsgBox "BOM表格已另存为" & FileName
'Part.ClearSelection
End If
End Sub
|
|