Attribute VB_Name = "Parameter_aus_und_einlesen"
' 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:     23.09.2010
' Zweck:        Es werden alle Parameter in ein Excelfile geschrieben um dies dort zu ändern und wieder in Catia zu importieren
'-----------------------------------------------------------------------------------
' Ä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

    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 Ergebniss 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
    
    MsgBox "Nachdem Sie die Werte in Excel geändert haben," & vbNewLine & _
    "klicken Sie auf den Button OK um das Makro fortzusetzen.", vbInformation + vbOKOnly, "Werte in Excel ändern"
    
    '***Dokumenentyp auslesen
    If strTyp = "PartDocument" Then
        Set objPart = objDoc.Part
        Set objParameters = objPart.Parameters
    
        For intI = 1 To objSel.Count
            '***Parameter ansprechen
            Set prmParameter = objParameters.Item(objSel.Item(intI).Value.Name)
            '***Wert von Excel in Catia importieren
            prmParameter.Value = objExcel.Cells(5 + intI, 2)
        Next
        
        '****Part updaten
            objPart.Update
    ElseIf strTyp = "ProductDocument" Then
        Set objProduct = objDoc.Product
        Set objParameters = objProduct.Parameters
        
        For intI = 1 To objSel.Count
            '***Parameter ansprechen
            Set prmParameter = objParameters.Item(objSel.Item(intI).Value.Name)
            '***Wert von Excel in Catia importieren
            prmParameter.Value = objExcel.Cells(5 + intI, 2)
        Next
        
        '***Product updaten
        objProduct.Update
    End If
        
    '***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
