---

Hallo,

nachdem ich (siehe CODE) meine Stücklisten-Daten erfolgreich in eine entsprechende Excel-Tabelle schreiben kann, suche ich jetzt folgende Lösung:

Im Feld "Zeichnungsnummern" (in der Excel-Tab) möchte ich die jeweiligen Einträge als Hyperlink darstellen, so dass der Anwender mit einem Klick die jeweilige Zeichnung (als PDF abgelegt) öffnen kann.

Ich hoffe, dass ich hier entsprechende Lösungsansätze erfahren kann...

CODE:
--------------------------------------------------
Sub StkLst_export()

On Error Resume Next

Dim oapp As Inventor.Application
Set oapp = ThisApplication

Dim oDoc As Inventor.DrawingDocument

If oapp.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
    MsgBox "Funktion ist nur in Zeichnungen zulässig"
    Exit Sub
End If

Set oDoc = oapp.ActiveDocument

Dim oOptions As NameValueMap
Dim iPropInf As PropertySet
Set iPropInf = oDoc.PropertySets.Item("Inventor Summary Information")
Dim iPropInf1 As PropertySet
Set iPropInf1 = oDoc.PropertySets.Item("Design Tracking Properties")
Dim iPropInf2 As PropertySet
Set iPropInf2 = oDoc.PropertySets.Item("Inventor Summary Information")
Dim iStockNumberProp As Property
Set iStockNumberProp = iPropInf1.Item("Stock Number")
Dim iDescription As Property
Set iDescription = iPropInf1.Item("Description")
Dim iRevisionNo As Property
Set iRevisionNo = iPropInf2.Item("Revision Number")

Dim oName As String
Dim oStart As String
Dim oTemplate As String
Dim oFullFileName As String
Dim oFileName As String
Dim oXLSFileName As String
Dim oLength As String
Dim oFit As Boolean
Dim oProp As PropertySet
Dim i As Property
Dim POS As String
Dim fso As Object
Set fso = CreateObject("Scripting.FilesystemObject")

Dim oPartsList As PartsList

Set oProp = oDoc.PropertySets.Item("Design Tracking Properties")

Dim iSubjectProp As Property
Set iSubjectProp = iPropInf.Item("Subject")

Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

' Dateiname mit Revision setzen
oXLSFileName = fso.GetParentFolderName(oDoc.FullFileName) & "\" & iStockNumberProp.Value & iRevisionNo.Value & "_" & iDescription.Value & ".xlsx"
'oName = Name des Excel- Sheets
oName = "Stückliste"
'oStart = Start- Zelle
oStart = "A3"
'oTemplate = Pfad zum xls- Template
oTemplate = "C:\VAULT_LWS\Organisatorisches\Vorlagen\Bestellliste.xls"
'oFit bewirkt, dass die Zellen eingepasst werden
'true - Zellen werden angepasst
'false - Zellen werden nicht angepasst
oFit = True

Call oOptions.Add("TableName", oName)
Call oOptions.Add("StartingCell", oStart)
Call oOptions.Add("Template", oTemplate)
Call oOptions.Add("AutoFitColumnWidth", oFit)

Stkl_Marker:
If oDoc.ActiveSheet.PartsLists.Count = 0 Then
    ' es ist keine Stückliste vorhanden! - Es wird eine Stückliste eingefügt!
    MsgBox "es ist keine Stückliste vorhanden! - Es wird die Stückliste eingefügt!"
    Call Stückliste_einfügen
    GoTo Stkl_Marker
ElseIf oDoc.ActiveSheet.PartsLists.Count = 1 Then
    ' Es ist eine Stückliste vorhanden! - Es wird die Stückliste "Einkauf" eingefügt und verwendet!
    MsgBox "Es ist eine Stückliste vorhanden! - Es wird die Stückliste Einkauf eingefügt und verwendet!"
    Call Einkaufsliste_einfügen
End If

Call oDoc.ActiveSheet.PartsLists.Item(2).Export(oXLSFileName, kMicrosoftExcel, oOptions)

'************************* Ab hier der EXCEL- PART ****************
'Im Inventor VBA- Projekt auf Extras - Verweise und
'die Microsoft Excel Library hinzufügen
'******************************************************************

Dim oExl As New Excel.Application

On Error Resume Next

Set partlist = oDoc.ActiveSheet.PartsLists.Item(2)
oExl.Workbooks.Open (oXLSFileName)

Set oExl = GetObject(, "Excel.Application")
  If Err.Number Then
    Err.Clear
    On Error Resume Next
    Set oExl = CreateObject("Excel.Application")
    If Err.Number Then
      Err.Clear
      MsgBox "Kann Excel nicht öffnen."
    End If
  End If
 
'Stückliste mit allen Ebenen erweitern
'Dim counter As Integer
'Dim k As Long
'counter = 1
'While counter < partlist.PartsListRows.Count
'    For k = counter To partlist.PartsListRows.Count
'        Dim orow As PartsListRow
'        Set orow = partlist.PartsListRows.Item(k)
'        counter = k
'        While orow.Expandable And Not (orow.Expanded)
'            orow.Expanded = False
'            counter = counter + 1
'        Wend
'    Next k
'Wend
'orow.Expanded = False

' Baugruppen-Benennung mit in die Tabelle eintragen
Dim j As Integer
With oExl.ActiveWorkbook
For j = 1 To partlist.PartsListRows.Count
    .Sheets(oName).Cells(j + 3, 10) = iSubjectProp.Value
Next j
.Close 1
End With

Set oWorkSheet = Nothing
Set oWorkbook = Nothing
Set oExcel = Nothing

Call partlist.Delete

oExl.Quit

End Sub
---------------------------------------------------------

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

---

Hallo ofencad,

ich habe das Problem so gelöst:
In der Excel-Vorlage gibt es eine Spalte - z.B. Spalte H, die nicht vom Export beschrieben wird.
die Zellen xx in Spalte H haben als Inhalt =HYPERLINK(Vxx)
In Spalte V füge ich beim Export die Dateinamen ein.
Wenn man nun auf H2 klickt wird das PDF mit dem Link in V2 geöffnet

------------------
Gruß Roland

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

---

Danke, ich denke, dass dies durchaus funktionieren wird...
Das probiere ich gleich Montag im Büro aus.

Gruß

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