' Sample 17: Excel Part List Report.BAS
' 
'This is a completely revised version of the same file renamed to: old_X & Y Part Location Report.bas
'This script has been generated by PowerPCB's VB Script Wizard on 8/23/2007 3:19:25 PM
'It will create reports in Microsoft Excel Format.
'You can use the following code as a skeleton for your own VB scripts

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

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

        tempS = ""

	'Output table header
	For i = 0 to UBound(Columns)
		Print #1, Columns(i);
                Print #1, COMMA;
               
	Next
	Print #1
	'Output table rows
	For Each part in ActiveDocument.Components
        	Print #1, part.Name;   
        	Print #1, COMMA;

		Print #1, part.PartType;
                Print #1, COMMA;

		Print #1, part.Decal;
		Print #1, COMMA;

                tempS = ""
		For Each attr In part.Attributes
		    If attr.Name = "Value" Then 
		       If TypeName(attr.value) = "String"  Then
                        tempS = attr.value
                       End If
 
                    End If
		Next

		If Len(tempS)<1 Then
                 tempS=part.PartType

		End If

                Print #1, tempS;
		Print #1, COMMA;


		Print #1, ActiveDocument.LayerName(part.layer);
                Print #1, COMMA;

		Print #1, part.orientation;
                Print #1, COMMA;

		Print #1, Format(part.PositionX, "0.000");
		Print #1, COMMA;

		Print #1, Format(part.PositionY, "0.000");
		Print #1, COMMA;

		Print #1, Format(part.IsSMD, "Yes/No");
		
		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.ActiveSheet.Paste
	xl.Range("A1:J1").Font.Bold = True
	xl.Range("A1:J1").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