Attribute VB_Name = "Modul1"

Public Sub Transparenz_ein_aus()

'************************************
' Makro zum Ändern der Transparenz
' Schableger Thomas
' 07.10.2004
'************************************

'Variablendeklaration
Dim oPartDoc As PartDocument
Dim oMaterial As Material
Dim oRenderStyle As RenderStyle
Dim oAssDoc As AssemblyDocument
Dim oOccurrence As ComponentOccurrence
Dim doc As Document

'Prüfung ob Teil geöffnet
   If ThisApplication.ActiveDocumentType = kPartDocumentObject Then
    GoTo transpart
    Else
    GoTo nx
   End If
   
'Prüfung ob Baugruppe oder anderes Dokument geöffnet ist
nx:
   If ThisApplication.ActiveDocumentType = kAssemblyDocumentObject Then
   GoTo transass
     Else
     MsgBox "Ungültiges Document", vbOKOnly
     GoTo ex
   End If

'Routine für Transparenz bei Part
transpart:
Set oPartDoc = ThisApplication.ActiveDocument
For Each oRenderStyle In oPartDoc.RenderStyles
     If oRenderStyle.InUse = True Then
      If oRenderStyle.Opacity = 1 Then
        oRenderStyle.Opacity = 0.5
        Else
        oRenderStyle.Opacity = 1
       End If
     End If
    Next

GoTo ex
    
'Routine für Transparenz bei Part in Assembly
transass:
    On Error Resume Next
    Set oOccurrence = ThisApplication.ActiveDocument.SelectSet.Item(1)
    If err Then Exit Sub
    Set doc = oOccurrence.Definition.Document
    Dim CurFileName As String
    CurFileName = doc.FullFileName
    
For Each oRenderStyle In doc.RenderStyles
     If oRenderStyle.InUse = True Then
       If oRenderStyle.Opacity = 1 Then
        oRenderStyle.Opacity = 0.5
        Else
        oRenderStyle.Opacity = 1
       End If
     End If
    Next

ex:
Exit Sub

End Sub