' 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("Designator", "Comment", "Footprint", "Mid X(mm)", "Mid Y(mm) ", "Rotation", "Head ", "FeederNo", "Mount Speed(%)", "Pick Height(mm)", "Place Height(mm)", "Mode", "Skip","Layer Sort Then Del Me")
'Array of column alignment: 0 - Align Left, 1 - Align Right, 2 - Align Center.
Const Align   = Array( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
Dim fname As String


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

	'Output table header
	

	For i = 0 to UBound(Columns)
		OutCell Columns(i)
	Next
	Print #2
	
	'Output table rows


	For Each part In ActiveDocument.Components
		OutCell part.Name
		OutCell AttrVal(part, "Value")
		OutCell AttrVal(part, "Decal.Type")
		OutCell Format(part.PositionX, "0.000")
		OutCell Format(part.PositionY, "0.000")
		OutCell part.Orientation
		Outcell Format("0")
		Outcell Format("")
		Outcell Format("200")
		Outcell Format("0")
		Outcell Format("0")
		Outcell Format("2")
		Outcell Format("0")
		OutCell part.layer
		Print #2
	Next part

	Close #2
 
	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("A1:P1").NumberFormat = "@"
	xl.Range("D1:P1").NumberFormat = "@"
	xl.ActiveSheet.Range("A12").Select
	'
	
	For i = 0 To UBound(Align)
		xl.Columns(i + 1).HorizontalAlignment = Choose(Align(i)+1, -4131, -4152, -4108)
	Next
	
	'
	'xl.ActiveSheet.HorizontalAlignment = xlLeft
	xl.ActiveSheet.Paste
	'x1.Worksheets.HorizontalAlignment = xlCenter
	'xl.Range("P2:P300").HorizontalAlignment = xlLeft 
	xl.Range("A12:P12").Font.Bold = True
	xl.Range("A1:P1").NumberFormat = "@"
	xl.Range("N13:N500").NumberFormat = "0"
	xl.Range("C13:C500").NumberFormat = "0000"
	'x1.Range ("A1") = "NEODEN"
	xl.Range("A1").Select
    xl.Application.Selection.value = "NEODEN"
    xl.Range("B1").Select
    xl.Application.Selection.value = "YY1"
    xl.Range("C1").Select
    xl.Application.Selection.value = "P&P FILE"
    xl.Range("A3").Select
    xl.Application.Selection.value = "PanelizedPCB"
    xl.Range("B3").Select
    xl.Application.Selection.value = "UnitLength"
    xl.Range("C3").Select
    xl.Application.Selection.value = "0"
    xl.Range("D3").Select
    xl.Application.Selection.value = "UnitWidth"
    xl.Range("E3").Select
    xl.Application.Selection.value = "0"
    xl.Range("F3").Select
    xl.Application.Selection.value = "Rows"
    xl.Range("G3").Select
    xl.Application.Selection.value = "1"
    xl.Range("H3").Select
    xl.Application.Selection.value = "Columns"
    xl.Range("I3").Select
    xl.Application.Selection.value = "1"
    '
    xl.Range("A5").Select
    xl.Application.Selection.value = "Fiducial"
    xl.Range("B5").Select
    xl.Application.Selection.value = "1-X"
    xl.Range("C5").Select
    xl.Application.Selection.value = "1.905"
    xl.Range("D5").Select
    xl.Application.Selection.value = "1-Y"
    xl.Range("E5").Select
    xl.Application.Selection.value = "7.62"
    xl.Range("F5").Select
    xl.Application.Selection.value = "OverallOffsetX"
    xl.Range("G5").Select
    xl.Application.Selection.value = "0"
    xl.Range("H5").Select
    xl.Application.Selection.value = "OverallOffsetY"
    xl.Range("I5").Select
    xl.Application.Selection.value = "0"
    '
    xl.Range("A7").Select
    xl.Application.Selection.value = "NozzleChange"
    xl.Range("B7").Select
    xl.Application.Selection.value = "OFF"
    xl.Range("C7").Select
    xl.Application.Selection.value = "BeforeComponent"
    xl.Range("D7").Select
    xl.Application.Selection.value = "1"
    xl.Range("E7").Select
    xl.Application.Selection.value = "Head1"
    xl.Range("F7").Select
    xl.Application.Selection.value = "Drop"
    xl.Range("G7").Select
    xl.Application.Selection.value = "Station2"
    xl.Range("H7").Select
    xl.Application.Selection.value = "PickUp"
    xl.Range("I7").Select
    xl.Application.Selection.value = "Station1"
    '
    xl.Range("A8").Select
    xl.Application.Selection.value = "NozzleChange"
    xl.Range("B8").Select
    xl.Application.Selection.value = "OFF"
    xl.Range("C8").Select
    xl.Application.Selection.value = "BeforeComponent"
    xl.Range("D8").Select
    xl.Application.Selection.value = "2"
    xl.Range("E8").Select
    xl.Application.Selection.value = "Head1"
    xl.Range("F8").Select
    xl.Application.Selection.value = "Drop"
    xl.Range("G8").Select
    xl.Application.Selection.value = "Station3"
    xl.Range("H8").Select
    xl.Application.Selection.value = "PickUp"
    xl.Range("I8").Select
    xl.Application.Selection.value = "Station2"
    '
        '
    xl.Range("A9").Select
    xl.Application.Selection.value = "NozzleChange"
    xl.Range("B9").Select
    xl.Application.Selection.value = "OFF"
    xl.Range("C9").Select
    xl.Application.Selection.value = "BeforeComponent"
    xl.Range("D9").Select
    xl.Application.Selection.value = "1"
    xl.Range("E9").Select
    xl.Application.Selection.value = "Head1"
    xl.Range("F9").Select
    xl.Application.Selection.value = "Drop"
    xl.Range("G9").Select
    xl.Application.Selection.value = "Station1"
    xl.Range("H9").Select
    xl.Application.Selection.value = "PickUp"
    xl.Range("I9").Select
    xl.Application.Selection.value = "Station1"
    '
            '
    xl.Range("A10").Select
    xl.Application.Selection.value = "NozzleChange"
    xl.Range("B10").Select
    xl.Application.Selection.value = "OFF"
    xl.Range("C10").Select
    xl.Application.Selection.value = "BeforeComponent"
    xl.Range("D10").Select
    xl.Application.Selection.value = "1"
    xl.Range("E10").Select
    xl.Application.Selection.value = "Head1"
    xl.Range("F10").Select
    xl.Application.Selection.value = "Drop"
    xl.Range("G10").Select
    xl.Application.Selection.value = "Station1"
    xl.Range("H10").Select
    xl.Application.Selection.value = "PickUp"
    xl.Range("I10").Select
    xl.Application.Selection.value = "Station1"
    '

	'
	xl.Range("I13").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 #2, txt; vbTab;
End Sub

Function AttrVal (obj As Object, nm As String)
	AttrVal = IIf(obj.Attributes(nm) Is Nothing, "", obj.Attributes(nm))
End Function
Sub FillClipboard
	' Load whole file to string variable    
	tempFile = DefaultFilePath & "\temp.txt"
	Open tempFile  For Input As #2
	L = LOF(2)
	AllData$ = Input$(L,2)
	Close #2
	'Copy whole data to clipboard
	Clipboard AllData$ 
	Kill tempFile
End Sub