This may sound a little bit dumb, but I have never experienced anything like this before with SolidWorks macro. I have written a SolidWorks macro that inserts a BOM table into an assembly saves it as excel, and adds needed formulas to an excel file. However it works 1 time out of 2- 1st time- all good, 2nd time I get an error- "Run-time error '1004' Method 'Rows' of object '_Global' Failed", 3rd time- all good, 4th time I get the same error and so on and so on. I'm really new to excel macro so I don't know if I'm missing something or just stupid?
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swBOMAnnotation As SldWorks.BomTableAnnotation
Dim i As Integer
Dim nNumRow As Variant
Dim swTableAnn As SldWorks.TableAnnotation
Dim swAnn As SldWorks.Annotation
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim template As String
Dim fType As String
Dim configuration As String
'excel variables
Dim x1App As Excel.Application
Dim xlWB As Excel.Workbook
Dim NextRow As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
template = "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\lang\english\bom-all.sldbomtbt"
fType = swBomType_PartsOnly
configuration = "Default"
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(template, 770, 240, fType, configuration, False, 2, True)
Dim path As String
path = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
Dim fpath As String
fpath = Format(path & "BOM\")
On Error Resume Next
MkDir (fpath)
On Error GoTo 0
Dim fName As String
fName = Format(fpath & "TEST.xls")
swBOMAnnotation.SaveAsExcel fName, False, False
Set swTableAnn = swBOMAnnotation
Set swAnn = swTableAnn.GetAnnotation
swAnn.Select3 False, Nothing
swModel.EditDelete
'Excel part
Set x1App = New Excel.Application
x1App.Visible = True
Set xlWB = x1App.Workbooks.Open(fName)
With Range("G3:G" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=C3*F3"
End With
NextRow = Range("G" & Rows.Count).End(xlUp).Row + 1
Range("G" & NextRow).Formula = "=SUM(G2:G" & NextRow - 1 & ")"
End Sub
Not sure what's causing the behavior you're describing but here are a few thoughts that might point you in the right direction.
Objects in macros are persistent, meaning swModel (and other objects) will still exist after the macro is run. This is why you need to set it to 'Nothing' before using it again.
"Rows" is not defined anywhere so I'm surprised that code works at all. It must be late binding it to something... Rows is a method for an excel range but you're not using it that way. (range.Rows)
Try getting the row count explicitly in a double and using that instead. I suspect that will fix your issue.
Related
I have the below code which takes an XML file from a shared location and loads it into Excel. As soon as the file is opened, i get a "Run-time error '1004': Application-defined or object defined error" message.
Sub Load_XML()
Dim xml_file_path As String
Dim file_date As String
Worksheets("Start").Activate
file_date = Range("B1").Value
xml_file_path = "Y:\mydrive\" & file_date & "-000000_RREP1002.XML"
Workbooks.OpenXML Filename:= _
xml_file_path _
, LoadOption:=xlXmlLoadImportToList
Dim lstrow as Integer
Dim r as Range
lstrow = ActiveSheet.UsedRange.Rows.Count
Set r = Range("A2:AF & lstrow")
The code errors before the last line is executed, i.e. as soon as the OpenXML is done.
Any ideas please what could be causing this issue?
thanks!
I would refactor the code like below.
Public Sub Load_XML()
Dim wsStart As Worksheet
Set wsStart = ThisWorkbook.Worksheets("Start")
Dim file_date As String
file_date = wsStart.Range("B1").Value ' make sure all ranges have a worksheet specified!
Dim xml_file_path As String
xml_file_path = "Y:\mydrive\" & file_date & "-000000_RREP1002.XML"
Workbooks.OpenXML Filename:=xml_file_path, LoadOption:=xlXmlLoadImportToList
Dim lstRow As Long
lstRow = wsStart.UsedRange.Rows.Count
' I recommend a more reliable method to find the
Dim r As Range
Set r = wsStart.Range("A2:AF" & lstRow)
I recommend a more reliable method to find the last usted row than using
lstRow = wsStart.UsedRange.Rows.Count
It is better you use
lstRow = wsStart.Cells(wsStart.Rows.Count, "A").End(xlUp).Row
This will find the last used row in column A. Adjust the column to one that has always data and no blanks.
This code line says = Nothing?
Set SrcDataRange = Src.Range("A13:P" & LastRow)
It`s in a Vlookup code shown below.
If there is a simpler way to write a Vlookup code please tell me?
I used the same code as before but different workbooks and it worked??
Private Sub Up_Date_Prices_Click()
Application.ScreenUpdating = False
Dim SrcOpen As Workbook
Dim Des As Workbook
Dim JCM As Worksheet
Dim Src As Worksheet
Dim FilePath As String
Dim Filename As String
Dim PLDataRange As Range
Dim LastRow As Long
FilePath = "\\TGS-SRV01\Share\ShopFloor\PRODUCTION\PURCHASING\"
Filename = "TGS Group Inventory Sheet - Main.xlsx"
Set SrcOpen = Workbooks.Open(FilePath & Filename)
Set Src = SrcOpen.Worksheets("Part List")
LastRow = Src.Cells(Src.Rows.Count, "A").End(xlUp).row
Set SrcDataRange = Src.Range("A13:P" & LastRow)
Windows("TGS Group Inventory Sheet - Main.xlsx").Visible = True
Set Des = Workbooks("Automated Cardworker.xlsm")
Set JCM = Des.Worksheets("Job Card Master")
JCM.Range("O15").Value = Application.WorksheetFunction.VLookup(JCM.Range("D15"), SrcDataRange, 16, 0)
Application.DisplayAlerts = False
SrcOpen.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
This row I think is wrong
LastRow = Src.Cells(PL.Rows.Count, "A").End(xlUp).row
PL is not set anywhere. Also the variable PLDataRange is never used. I guess you intend to set that somewhere?
I have Option Explicit turned on as default and it means you can never use undeclared variables
Let me know if this is helpful, thanks
I think this is answered here How to error handle 1004 Error with WorksheetFunction.VLookup?
In summary, if there is no match VLookup throws an error - if it is not this then check your last row: O15 your output is only 2 rows below A13 the first anchor to your input range so check that columnP doesnt extend below row 14.
Some observations, JCM.Range("D15") might be better as JCM.Range("D15").value and also the final parameter is actually a boolean so might be better as False rather than zero. They may or may not have any effects here but it may be helpful to get into that habit: Little mistakes like these have cost me hours debugging in the past :)
I want to open many pdfs in specific folder using word document and copy the contents and paste in my excel sheet without format change. The code which i have written was able to perform the task for 2 pdf files only after that it is showing run time error 462 - The remote server machine does not exist or is unavailable. Kindly help me what is going wrong and how i can resolve it? Thanks in advance.
Sub test()
Dim s As String
Dim path As String
Dim col As Integer: col = 1
Dim t As Excel.Range
path = "C:\Users\121919\Desktop\Direct Dispatch Report_PENS\29 Jul\PDF to Word Try\"
s = Dir(path & "*.pdf")
Do Until s = ""
Dim wd As New Word.Application
Dim mydoc As Word.document
Set mydoc = Word.Documents.Open(Filename:=path & s, Format:="PDF Files", ConfirmConversions:=False)
Dim wr As Word.Range
Set wr = mydoc.Paragraphs(1).Range
wr.WholeStory
Set t = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
wr.Copy
t.PasteSpecial xlPasteValues
mydoc.Close False: s = Dir
wd.Quit '<- This is where the code stops and throw error
Loop
End Sub
I have three workbooks; all with information on the same policies, but come from different documents. I'm trying to copy the value of the same cell from each worksheet that has the same worksheet name in workbooks 1 & workbook 3. This is the code that I have:
Sub foo()
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim wkb3 As Workbook
Dim shtName As String
Dim i As Integer
Set wkb1 = Workbooks.Open("C:\Users\lliao\Documents\Trad Reconciliation.xlsx")
Set wkb2 = Workbooks.Open("C:\Users\lliao\Documents\TradReconciliation.xlsx")
Set wkb3 = Workbooks.Open("C:\Users\lliao\Documents\Measure Trad Recon LS.xlsx")
shtName = wkb2.Worksheets(i).Name
For i = 2 To wkb2.Worksheets.Count
wkb2.Sheets(shtName).Range("D3").Value = wkb1.Sheets(shtName).Range("D2")
wkb2.Sheets(shtName).Range("E3").Value = wkb1.Sheets(shtName).Range("E2")
wkb2.Sheets(shtName).Range("F3").Value = wkb1.Sheets(shtName).Range("F2")
wkb2.Sheets(shtName).Range("D4").Value = wkb3.Sheets(shtName).Range("D2")
wkb2.Sheets(shtName).Range("E4").Value = wkb3.Sheets(shtName).Range("E2")
wkb2.Sheets(shtName).Range("F4").Value = wkb3.Sheets(shtName).Range("F2")
Next i
End Sub
I don't understand how I'm using the subscript wrong. This is my first time coding VBA (first time in 5+ years), so I'm unfamiliar with coding errors.
Thank you!
Dim i As Integer
Set wkb1 = Workbooks.Open("C:\Users\lliao\Documents\Trad Reconciliation.xlsx")
Set wkb2 = Workbooks.Open("C:\Users\lliao\Documents\TradReconciliation.xlsx")
Set wkb3 = Workbooks.Open("C:\Users\lliao\Documents\Measure Trad Recon LS.xlsx")
shtName = wkb2.Worksheets(i).Name
Variable i is declared, but used before it's assigned - its value is therefore an implicit 0.
With VBA collections being 1-based, that makes wkb2.Worksheets(i) be out of bounds.
Dim i As Integer
i = 1
'...
shtName = wkb2.Worksheets(i).Name
Will fix it.
You probably want to move it inside the loop though.
may be you're after this:
For i = 2 To wkb2.Worksheets.Count
wkb2.Sheets(i).Range("D3:F3").Value = wkb1.Sheets(i).Range("D2:F2")
wkb2.Sheets(i).Range("D4:F4").Value = wkb3.Sheets(i).Range("D2:F2")
Next i
I have to know how can i link the excel database of Instrument loop Diagram in AutoCad format. I have AutoCad Template for a loop typical and Excel Database in which i have 100 Loops information for particular typical.I have AutoCad 2006,2007 and 2011 with me. please suggest idea for linking and generating he AutoCAD Drawings automatically.
The easiest way would be to learn a bit of AutoLisp, which is really worth learning if you're into generating drawings or automating your processes within AutoCAD.
Here's a great website for learning AutoLisp:
http://www.afralisp.net/index.php
AutoDesk's Lisp forum is also a great source of help.
As for extracting the data from Excel, here is a library which really facilitates access from AutoLisp:
http://download.cnet.com/KozMos-VLXLS/3000-2077_4-94214.html
'General rule: excel and acad have to be same like both 64bit or both 32 bit !!!
' You will need to add a reference to the AutoCAD
' Type Library to run this example book. Use the "Tools -
' References" menu. If you prefere you can switch to late
' binding by changeing the AutoCAD types to generic objects
Public Sub Excel_drives_acadPolyline_import_POINTs()
Dim objApp As AcadApplication
Dim objDoc As AcadDocument
Dim objEnt As AcadEntity
Dim varPnt As Variant
Dim strPrmpt As String
Dim intVCnt As Integer
Dim varCords As Variant
Dim varVert As Variant
Dim varCord As Variant
Dim varNext As Variant
Dim intCrdCnt As Integer
On Error GoTo Err_Control
Set objApp = AINTERFACE.Iapp
Set objDoc = objApp.activedocument
AppActivate objApp.CAPTION
objDoc.Utility.GetEntity objEnt, varPnt
If TypeOf objEnt Is AcadLWPolyline Then
AppActivate ThisDrawing.applicaTION.CAPTION
varCords = objEnt.COORDINATES
For Each varVert In varCords
intVCnt = intVCnt + 1
Next
For intCrdCnt = 0 To intVCnt / 2 - 1
varCord = objEnt.COORDINATE(intCrdCnt)
Excel.applicaTION.Cells(intCrdCnt + 1, 1).value = varCord(0)
Excel.applicaTION.Cells(intCrdCnt + 1, 2).value = varCord(1)
Next intCrdCnt
Else
MsgBox "Selected entity was not a LWPolyline"
End If
Exit_Here:
If Not objApp Is Nothing Then
Set objApp = Nothing
Set objDoc = Nothing
End If
Exit Sub
Err_Control:
'debug.print err.DESCRIPTION
Resume Exit_Here
End Sub
'----------------------------------------------------------------
' You will need to add a reference to the Excel
' Type Library to run this.In case of excel excel.exe is the library !
Sub acad-drives_excel()
Dim xAP As Excel.applicaTION
Dim xWB As Excel.Workbook
Dim xWS As Excel.WorkSheet
Set xAP = Excel.applicaTION
Set xWB = xAP.Workbooks.Open(SLOPEDIR.PROJECT & "\A2K2_VBA\IUnknown.xls")
Set xWS = xWB.Worksheets("Sheet1")
MsgBox "Excel says: """ & Cells(1, 1) & """"
Dim A2K As AcadApplication
Dim A2Kdwg As AcadDocument
Set A2K = AINTERFACE.Iapp
Set A2Kdwg = A2K.applicaTION.documents.Add
MsgBox A2K.NAME & " version " & A2K.version & _
" is running."
Dim HEIGHT As Double
Dim p(0 To 2) As Double
Dim TxtObj As ACADTEXT
Dim TxtStr As String
HEIGHT = 1
p(0) = 1: p(1) = 1: p(2) = 0
TxtStr = Cells(1, 1)
Set TxtObj = A2Kdwg.modelspace.AddText(TxtStr, _
p, HEIGHT)
A2Kdwg.SaveAs SLOPEDIR.PROJECT & "\A2K2_VBA\IUnknown.dwg"
A2K.documents.Close
A2K.Quit
Set A2K = Nothing
xAP.Workbooks.Close
xAP.Quit
Set xAP = Nothing
End Sub
Whatever way you choose now you can draw into the autocad drawing by using VBA.
There is another way for non programmers.
AUTOCAD SCRIPT
in fact you can create a excel table which creates this things and then you can export them to a text file. For simple task a solution but crap if you hase more complex things to do.
And last but not least you can create dynamic blocks and use vba to insert them and set the values of their parameters according to your excel sheet. But this would explode this tiny post