Attribute VB_Name = "Parameter_auslesen"
' Makro:        Parameter_aus_und_einlesen
' Version:      1.0
' Catia Level:  V5R19
' UIL:          English (User Interface Language)
' Autor:        Christian Obholzer
' E-Mail:       ch.obholzer@aon.at
' Erstellt:     24.03.2011
' Zweck:        Es werden alle Parameter in ein Excelfile geschrieben
'-----------------------------------------------------------------------------------
' Änderungen:   Datum, Name
'               Hier wird die Änderung angegeben
'               Datum, Name
'               Hier wird die Änderung angegeben
'-----------------------------------------------------------------------------------

Option Explicit
    
Sub CATMain()

    '***Deklarationen
    Dim objWindows As Windows
    Dim objDoc As Document
    Dim strTyp As String
    Dim objProduct As Product
    Dim objPart As Part
    Dim objSel As Object
    Dim objParameters As Parameters
    Dim prmParameter As Parameter
    Dim objExcel As Object
    Dim WB As Workbook
    Dim intI As Integer

    '***Fehlerroutine einschalten
    On Error GoTo Fehler

    '***Abfrage nach geöffnetem Dokument
    Set objWindows = CATIA.Windows
    If objWindows.Count = 0 Then
        MsgBox "Es ist kein Dokument geöffnet." + vbNewLine + _
        "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Kein Dokument offen"
        Exit Sub
    End If

    '***Auslesen der Dokumentart
    Set objDoc = CATIA.ActiveDocument
    strTyp = TypeName(objDoc)
    If strTyp = "DrawingDocument" Then
        MsgBox "Dieses Dokument ist ein Drawing." + vbNewLine + _
        "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Falscher Dokumententyp"
        Exit Sub
    End If

    '***Excel starten
    Set objExcel = CreateObject("Excel.Application")
    '***Excel sichtbar schalten
    objExcel.Application.Visible = True
    '***Datei erstellen
    Set WB = objExcel.Workbooks.Add

    '***Überschrift eintragen
    objExcel.Cells(1, 1).Value = "Parameter aus und einlesen"
    '***Schriftart: Fett
    objExcel.Cells(1, 1).Font.Bold = True
    '***Schriftfarbe: Rot
    objExcel.Cells(1, 1).Font.Color = -16776961
    '***Schriftgröße: 16
    objExcel.Cells(1, 1).Font.Size = 16
    '***Schrifttyp: Kursiv
    objExcel.Cells(1, 1).Font.Italic = True
    '***Überschrift unterstreichen
    objExcel.Cells(1, 1).Font.Underline = xlUnderlineStyleSingle
    '***Zellen verbinden
    objExcel.Range("A1:B1").MergeCells = True
    '***Zellenausrichtung Horizontal
    objExcel.Range("A1:B1").HorizontalAlignment = xlCenter
    '***Zellenausrichtung Vertikal
    objExcel.Range("A1:B1").VerticalAlignment = xlBottom
    '***Spaltenbreite
    objExcel.Columns("A:A").ColumnWidth = 32

    '***Überschrift der Unterkategorie eintragen
    objExcel.Cells(5, 1).Value = "Parametername"
    '***Schriftart: Fett
    objExcel.Cells(5, 1).Font.Bold = True
    '***Überschrift der Unterkategorie eintragen
    objExcel.Cells(5, 2).Value = "Wert"
    '***Schriftart: Fett
    objExcel.Cells(5, 2).Font.Bold = True

    Set objSel = objDoc.Selection
    '***Vorselektion löschen um das Ergebnis nicht zu verfälschen
    objSel.Clear

    '***Performanceerhöhung der Suche
    CATIA.HSOSynchronized = False
    '***Parameter suchen
    objSel.Search "Knowledgeware.Parameter.Name !=Origin*"
    CATIA.HSOSynchronized = True
    
    '***Anzahl der gefunden Parameter eintragen
    objExcel.Cells(3, 1).Value = "Anzahl gefundener Parameter:"
    objExcel.Cells(3, 2).Value = objSel.Count
    '***Schriftart: Fett
    objExcel.Cells(3, 2).Font.Bold = True
    
    If objSel.Count > 0 Then

        For intI = 1 To objSel.Count
            '***Parameternamen eintragen
            objExcel.Cells(5 + intI, 1).Value = objSel.Item(intI).Value.Name
            
            '***Werte eintragen
            objExcel.Cells(5 + intI, 2).Value = objSel.Item(intI).Value.Value
        Next
    End If
    
    '***Meldung an User
    MsgBox "Speichern Sie die Werte in ein neues Excelfile," & vbNewLine & _
    "da dieses File geschlossen wird.", vbInformation + vbOKOnly, "Excel wird geschlossen"
        
    '***Datei ohne speichern schließen
    WB.Close False

    '***Excel beenden
    objExcel.Application.Quit
        
    objSel.Clear

Exit Sub

'***Fehlerbehandlung: Ausgabe der Fehlernummer und Fehlerbeschreibung
Fehler:
    MsgBox "Fehlernummer: " & Err.Number & vbNewLine & _
    "Fehlerbeschreibung: " & Err.Description, vbCritical + vbOKOnly, "Fehler"
    
    '***Excel beenden
    objExcel.Application.Quit

End Sub
