---

obnjectrequoihred.jpg

Ich hatte schon mal so ein roblem nur komme ich hier nicht mit der ähnlichen Lösung wie im anderen auf einen richtigen Weg.
http://ww3.cad.de/foren/ubb/Forum258/HTML/001660.shtml#000002

Code:

---

Sub Test()
    GetSubDocumentType (ThisApplication.ActiveDocument)
End Sub

Public Function GetSubDocumentType(oDoc) As String
    'access the active document
    'Dim oDoc As Document
    'Set oDoc = ThisApplication.ActiveDocument

    'get the document type
    Dim eDocumentType As DocumentTypeEnum
    Set eDocumentType = oDoc.DocumentType ' <------------- Object required
   
    Dim sDocumentType As String
    Select Case eDocumentType:
    Case kAssemblyDocumentObject
        sDocumentType = "Assembly Document"
    Case kDesignElementDocumentObject
        sDocumentType = "DesignElement Document"
    Case kDrawingDocumentObject
        sDocumentType = "Drawing Document"
    Case kForeignModelDocumentObject
        sDocumentType = "ForeignModel Document"
    Case kPartDocumentObject
        sDocumentType = "Part Document"
    Case kPresentationDocumentObject
        sDocumentType = "Presentation Document"
    Case kSATFileDocumentObject
        sDocumentType = "SATFile Document"
    Case kUnknownDocumentObject
        sDocumentType = "Unknown Document"
    End Select
   
    'get the document sub-type
    Dim sDocumentSubType As String
    sDocumentSubType = oDoc.SubType
    Dim sReadableType As String
    'part document sub-types
   
    'part
    Select Case sDocumentSubType:
    Case "{4D29B490-49B2-11D0-93C3-7E0706000000}"
        sReadableType = "part"
    'sheet metal
    Case "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
        sReadableType = "sheet metal"
    'generic proxy
    Case "{92055419-B3FA-11D3-A479-00C04F6B9531}"
        sReadableType = "generic proxy"
    'compatibility proxy
    Case "{9C464204-9BAE-11D3-8BAD-0060B0CE6BB4}"
        sReadableType = "compatibility proxy"
    'catalog proxy
    Case "{9C88D3AF-C3EB-11D3-B79E-0060B0F159EF}"
        sReadableType = "catalog proxy"
    'assembly document sub-types
    Case "{E60F81E1-49B3-11D0-93C3-7E0706000000}"
        sReadableType = "assembly"
    'drawing document sub-types
    Case "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}"
        sReadableType = "drawing"
    'design element document sub-types
    Case "{62FBB030-24C7-11D3-B78D-0060B0F159EF}"
        sReadableType = "design element"
    'presentation document sub-types
    Case "{76283A80-50DD-11D3-A7E3-00C04F79D7BC}"
        sReadableType = "presentation"
    End Select
    MsgBox ("Document Type: " & sDocumentType & vbNewLine & "Document SubType: " + sReadableType)
    GetSubDocumentType = sReadableType
End Function

---

------------------
Grüße aus Wien
Philipp
Email: Base64 Encoded:
cGhpcHNfOTJAeWFob28uZGU=

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Versuch mal so:

Code:

---

Option Explicit

Sub Test()
    Dim Result As String
    Result = GetSubDocumentType(ThisApplication.ActiveDocument)
End Sub

Public Function GetSubDocumentType(ByVal oDoc As Document) As String
    'access the active document
    'Dim oDoc As Document
    'Set oDoc = ThisApplication.ActiveDocument

    'get the document type
    Dim eDocumentType As DocumentTypeEnum
    eDocumentType = oDoc.DocumentType ' <------------- Object required
 
    Dim sDocumentType As String
    Select Case eDocumentType:
    Case kAssemblyDocumentObject
        sDocumentType = "Assembly Document"
    Case kDesignElementDocumentObject
        sDocumentType = "DesignElement Document"
    Case kDrawingDocumentObject
        sDocumentType = "Drawing Document"
    Case kForeignModelDocumentObject
        sDocumentType = "ForeignModel Document"
    Case kPartDocumentObject
        sDocumentType = "Part Document"
    Case kPresentationDocumentObject
        sDocumentType = "Presentation Document"
    Case kSATFileDocumentObject
        sDocumentType = "SATFile Document"
    Case kUnknownDocumentObject
        sDocumentType = "Unknown Document"
    End Select
 
    'get the document sub-type
    Dim sDocumentSubType As String
    sDocumentSubType = oDoc.SubType
    Dim sReadableType As String
    'part document sub-types
 
    'part
    Select Case sDocumentSubType:
    Case "{4D29B490-49B2-11D0-93C3-7E0706000000}"
        sReadableType = "part"
    'sheet metal
    Case "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
        sReadableType = "sheet metal"
    'generic proxy
    Case "{92055419-B3FA-11D3-A479-00C04F6B9531}"
        sReadableType = "generic proxy"
    'compatibility proxy
    Case "{9C464204-9BAE-11D3-8BAD-0060B0CE6BB4}"
        sReadableType = "compatibility proxy"
    'catalog proxy
    Case "{9C88D3AF-C3EB-11D3-B79E-0060B0F159EF}"
        sReadableType = "catalog proxy"
    'assembly document sub-types
    Case "{E60F81E1-49B3-11D0-93C3-7E0706000000}"
        sReadableType = "assembly"
    'drawing document sub-types
    Case "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}"
        sReadableType = "drawing"
    'design element document sub-types
    Case "{62FBB030-24C7-11D3-B78D-0060B0F159EF}"
        sReadableType = "design element"
    'presentation document sub-types
    Case "{76283A80-50DD-11D3-A7E3-00C04F79D7BC}"
        sReadableType = "presentation"
    End Select
    MsgBox ("Document Type: " & sDocumentType & vbNewLine & "Document SubType: " + sReadableType)
    GetSubDocumentType = sReadableType
End Function

---

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Super danke!

------------------
Grüße aus Wien
Philipp
Email: Base64 Encoded:
cGhpcHNfOTJAeWFob28uZGU=

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP