Public Sub export_ExportParamsToExcel()
    Dim oParams As Parameters
    Dim sDocName As String
    Dim i As Long
    Dim iRow As Long
    Const PI As Double = 3.14159265358979
    '3,1415926535897932
    
    'Next 3 declarations commented during production.
    ' Uncomment during development, but need reference to Excel (Tools>References>microsoft Excel 10.0 Object libary
    'This way no Reference to Excel required (more stable and Excel version independent
    'See also Note: OPEN_EXCEL.
'    Dim XL As New Excel.Application
'    Dim xlWB As Excel.Workbook
'    Dim xlWS As Excel.WorkSheet
    Dim XL As Object
    Dim xlWB As Object
    Dim xlWS As Object
    
    If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject And _
        ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
        MsgBox "Only Part or Assymbly document", vbCritical
        Exit Sub
    End If
    Set oParams = ThisApplication.ActiveDocument.ComponentDefinition.Parameters
    
    'Connect to Excel, and create a new Workbook
    'Note: OPEN_EXCEL.
    Set XL = CreateObject("Excel.Application")
    Set xlWB = XL.Workbooks.Add
    Set xlWS = xlWB.ActiveSheet
    XL.Visible = True
    
    'Write the Header Row
    iRow = 1
    xlWS.Cells(iRow, 1).Value = "Type"
    xlWS.Cells(iRow, 2).Value = "Name"
    xlWS.Cells(iRow, 3).Value = "Kommentar"
    xlWS.Cells(iRow, 4).Value = "Nennwert"
    xlWS.Cells(iRow, 5).Value = "Equation"
    xlWS.Cells(iRow, 6).Value = "Export"
    xlWS.Cells(iRow, 7).Value = "Health"

    'Some Excel formatting:
    '1. Freeze Header row
    '2. Header Bold and bigger fontsize
    xlWS.Rows("2:2").Select
    XL.ActiveWindow.FreezePanes = True
    xlWS.Rows("1:1").Select
    XL.Selection.Font.Bold = True
    With XL.Selection.Font
        .Name = "Arial"
        .Size = 14
        .Bold = True
    End With

    For i = 1 To oParams.Count
   
    If oParams.Item(i).ExposedAsProperty = True Then
        iRow = iRow + 1
                
        Select Case oParams.Item(i).Type
            Case kModelParameterObject
                xlWS.Cells(iRow, 1).Value = "Model"
            Case kUserParameterObject
                xlWS.Cells(iRow, 1).Value = "User"
            Case kTableParameterObject
                xlWS.Cells(iRow, 1).Value = "Table"
        End Select
        
        xlWS.Cells(iRow, 2).Value = oParams.Item(i).Name
        xlWS.Cells(iRow, 3).Value = oParams.Item(i).Comment
                
        Select Case oParams.Item(i).Units
            Case "mm"
                xlWS.Cells(iRow, 4).Value = FormatNumber(oParams.Item(i).Value * 10, 4) & " mm"
            Case "grd"
                xlWS.Cells(iRow, 4).Value = FormatNumber(oParams.Item(i).Value * (180 / PI), 4) & " °"
            Case "oE"
                xlWS.Cells(iRow, 4).Value = FormatNumber(oParams.Item(i).Value, 1) & " oE"
            Case Else
                xlWS.Cells(iRow, 4).Value = oParams.Item(i).Value
        End Select
                    
                
        xlWS.Cells(iRow, 5).Value = oParams.Item(i).Expression
        xlWS.Cells(iRow, 6).Value = oParams.Item(i).ExposedAsProperty
        
        Select Case oParams.Item(i).HealthStatus
            Case kDeletedHealth
                xlWS.Cells(iRow, 7).Value = "Deleted"
            Case kDriverLostHealth
                xlWS.Cells(iRow, 7).Value = "Driver Lost"
            Case kInErrorHealth
                xlWS.Cells(iRow, 7).Value = "In Error"
            Case kOutOfDateHealth
                xlWS.Cells(iRow, 7).Value = "Out of Date"
            Case kUnknownHealth
                xlWS.Cells(iRow, 7).Value = "Unknown"
            Case kUpToDateHealth
                xlWS.Cells(iRow, 7).Value = "Up to Date"
        End Select
        
        End If
        
    Next 'i
    
    'Format the entire page so cell contents fit
    XL.Cells.Select
    XL.Cells.EntireColumn.AutoFit
    xlWS.Range("A1").Select
    
    'save this XL document, default to Inventor location and name
    sDocName = ThisApplication.ActiveDocument.FullFileName
    If sDocName = "" Then
        sDocName = "c:\temp\x"
    Else
        sDocName = Mid(sDocName, 1, Len(sDocName) - 4)
    End If
    If Dir(sDocName & ".xls") <> "" Then
        i = 1
        Do While Dir(sDocName & "_" & i & ".xls") <> ""
            i = i + 1
        Loop
        sDocName = sDocName & "_" & i
    End If
    xlWB.SaveAs FileName:=sDocName & ".xls"
    
    'detach from XL
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set XL = Nothing
     
End Sub