AnsweredAssumed Answered

VB script variant usage

Question asked by leezuhars on Nov 12, 2014

VB script variant usage

Need code to use a variant name in component placement VB script.

Code should replace line For Each part In ActiveDocument.Components

 

'Array of column names. You can modify it to rename columns
Const Columns = Array("RefDes", "Centroid X", "Centroid Y", "Orient.", "PartType", "SMD", "ENGLISH_UNITS")

Sub Main
tempFile = DefaultFilePath & "\temp.txt"
Open tempFile For Output As #1

'Output table header
For i = 0 to UBound(Columns)
  OutCell Columns(i)
Next
Print #1
'Output table rows
For Each part In ActiveDocument.Components
  OutCell part.Name
  OutCell Format(part.CenterX, "0.000") 'Creates locations based on the outermost extents
  OutCell Format(part.CenterY, "0.000") 'of pins and part outline making up the decal.
  OutCell part.orientation
  OutCell part.PartType
  OutCell Format(part.IsSMD, "Yes/No")
  'The following block was added to pass these attributes out in the part list. The If... statements are needed to handle any
  'attributes that are blank. As it turns out, the non-existance of an object is an important case to handle!
  If part.Attributes("RefDes") Is Nothing Then
   Outcell ""
  Else
   OutCell part.Attributes("RefDes").value
  End If
  If part.Attributes("PartType") Is Nothing Then
   Outcell ""
  Else
   OutCell part.Attributes("PartType").value
  End If
  'End of the added stuff
  Print #1
Next part

Close #1
ExportToExcel
End Sub

Sub ExportToExcel
FillClipboard
Dim xl As Object
On Error Resume Next
Set xl =  GetObject(,"Excel.Application")
On Error GoTo ExcelError ' Enable error trapping.
If xl Is Nothing Then
  Set xl =  CreateObject("Excel.Application")
End If
xl.Visible = True
xl.Workbooks.Add
xl.Range("A:E").NumberFormat = "@"
xl.Range("D1:E1").NumberFormat = "@"
xl.ActiveSheet.Paste
xl.Range("A1:F1").Font.Bold = True
'xl.Range("A1:E1").NumberFormat = "@"
xl.ActiveSheet.UsedRange.Columns.AutoFit
xl.Range("A1").Select
On Error GoTo 0 ' Disable error trapping.
Exit Sub   

ExcelError:
MsgBox Err.Description, vbExclamation, "Error Running Excel"
On Error GoTo 0 ' Disable error trapping.   
Exit Sub
End Sub

Sub OutCell (txt As String)
Print #1, txt; vbTab;
End Sub

Sub FillClipboard
' Load whole file to string variable   
tempFile = DefaultFilePath & "\temp.txt"
Open tempFile  For Input As #1
L = LOF(1)
AllData$ = Input$(L,1)
Close #1
'Copy whole data to clipboard
Clipboard AllData$
Kill tempFile
End Sub

Outcomes