0

ハイパーリンクとして添付ファイルを含む Word .docx レポートを生成するアプリケーション (HP Quality Center) を使用しています。ハイパーリンクは PC の C:\ ドライブ上の添付ファイルを指しています。

明らかに、レポートを電子メールで送信したり、リンクを使用して別の場所に移動したりすることはできません。

これらのハイパーリンクを埋め込みオブジェクトに変換したいと考えています。

マクロを使用してハイパーリンクを反復処理し、ole オブジェクトを追加することもできますが、ClassType を無視しても問題ないかどうか疑問に思っています。ファイルは、.xls、pdf、doc、docx などです。ファイル名を見て ClassType を見つけることはできますか?

誰もこれを以前にやったことがありますか？

ありがとうジョン

更新 - 私がこれまでに持っているもの

Sub ConvertHyperLinks()
Dim num As Integer, i
Dim strFileName As String
Dim lngIndex As Long
Dim strPath() As String

num = ActiveDocument.Hyperlinks.Count
For i = 1 To num
    hName = ActiveDocument.Hyperlinks(i).Name
    strPath() = Split(hName, "\")
    lngIndex = UBound(strPath)
    strFileName = strPath(lngIndex)
    Selection.InlineShapes.AddOLEObject _
        FileName:=hName, _
        LinkToFile:=False, DisplayAsIcon:=True, _
        IconLabel:=strFileName
    ActiveDocument.Hyperlinks(i).Delete
Next
End Sub

FileName を使用したいので、ClassType は必要ないようです。

誰でも次のことを手伝ってもらえますか (a) ハイパーリンクにカーソルを置き、ドキュメント内の各場所に新しい行と OLEObject を入力できるようにします。(b) ファイル名の .ext から使用するアイコンを見つけます

ありがとう

4

2 に答える 2

0

これが私の解決策です。HP Quality Center に固有です。そして、今のところアイコンは無視します。

Sub ConvertHyperLinks()

'
' Macro to replace HyperLinks with embedded objects for
' report documents generated by HP Quality Center.
'

Dim numH, numT, i, j, k, m, n, rowCount, cellCount As Integer
Dim strPath() As String
Dim strFileName, strFileName2, strExt As String
Dim hName, tblCell1, reqidLabel, regId, preFixLen, preFix As String
Dim found As Boolean
Dim lngIndex As Long

numH = ActiveDocument.Hyperlinks.Count

For i = 1 To numH
    found = False
    hName = ActiveDocument.Hyperlinks(i).Name
    strPath() = Split(hName, "\")
    lngIndex = UBound(strPath)
    strFileName = strPath(lngIndex)
    strPath() = Split(strFileName, ".")
    lngIndex = UBound(strPath)
    strExt = UCase(strPath(lngIndex))

    strFileName2 = OnlyAlphaNumericChars(strFileName)

    'Each HyperLink is in single row/column table
    'And a FIELDLABEL table contains the REQ number
    'Iterate to find the current REQ number as it has been
    'prepended to the filename.
    'We are processess from start of doc to end
    'so the REQ number applies to the immediate Attachments
    'in the same document section.

    numT = ActiveDocument.Tables.Count
    For j = 1 To numT

      tblCell1 = OnlyAlphaNumericChars(ActiveDocument.Tables(j).Rows(1).Cells(1).Range.Text)

      If UCase(tblCell1) = "FIELDLABEL" Then
        rowCount = (ActiveDocument.Tables(j).Rows.Count)
        For k = 1 To rowCount
            cellCount = (ActiveDocument.Tables(j).Rows(k).Cells.Count)
            For m = 1 To cellCount
                reqidLabel = OnlyAlphaNumericChars(ActiveDocument.Tables(j).Rows(k).Cells(m).Range.Text)
                If reqidLabel = "ReqID" Then
                  regId = OnlyAlphaNumericChars(ActiveDocument.Tables(j).Rows(k).Cells(m + 1).Range.Text)
                  regId = "REQ" & regId
                  preFixLen = Len(regId)
                  preFix = Mid(strFileName2, 1, preFixLen)
                  If preFix = regId Then
                    found = True
                    Exit For
                  End If
                End If
            Next
            If found Then Exit For
        Next
      End If

      If found Then

         'Continue to iterate tables to find the actual table
         'containing the Link
         If UCase(regId & tblCell1) = UCase(strFileName2) Then
           'Select the table and move to the next document line
           'that follows it.
           ActiveDocument.Tables(j).Select
           Selection.Collapse WdCollapseDirection.wdCollapseEnd
           Selection.TypeText Text:=Chr(11)

           'Outstanding is finding an Icon for the type
           'of Object being embedded
           'This embeds with a blank Icon.
           'But the Icon caption is the Extension.

           Selection.InlineShapes.AddOLEObject _
               FileName:=hName, _
               LinkToFile:=False, DisplayAsIcon:=True, _
               IconLabel:=strExt
               'IconFileName:=strFileName, IconIndex:=0,

           Selection.TypeText Text:=Chr(11)
           Selection.TypeText Text:=strFileName
           Selection.TypeText Text:=Chr(11)
           Selection.TypeText Text:=Chr(11)
           Exit For
         End If
      End If
    Next
Next

'Delete all the Hyperlinks as they are meainingless
'if the document is to be emailed.
'TODO May delete the table the link is contained in.
With ActiveDocument
    For n = .Hyperlinks.Count To 1 Step -1
        .Hyperlinks(n).Delete
    Next
End With
End Sub
于 2013-07-15T16:42:47.827 に答える