需要从 MS Excel 的列表中展开 MS Word 中的多个查找和替换以替换带有超链接的文本并修复错误 [英] Need to expand Multiple find and replace in MS Word from a list in MS Excel to replace text w hyperlink and fix error

问题描述

我有一个大的 Word 文件，它自始至终引用了多个问题#.我还有一个 Excel 文件，其中列出了 A 列中的所有问题 #s，而 B 列中有一个实际问题列表，这些问题也是超链接.我想将 Word 文档中的每个问题 # 替换为电子表格 B 列中相应的超链接问题.

I have a large Word file that refers to multiple Question #s throughout. I also have an Excel file that lists all the Question #s in Column A and in Column B there is a list of actual questions that are also hyperlinks. I would like to replace every question # in the Word document with the corresponding hyperlinked question in Column B of the spreadsheet.

我尝试在 StackOverflow 问题中使用宏 从 MS Excel 的列表中在 MS Word 中进行多个查找和替换，但我得到了

I tried to use the macro in the StackOverflow question Multiple find and replace in MS Word from a list in MS Excel, but I get the

运行时错误1004":无法获取特殊单元格属性范围类.

Run-time error '1004': Unable to get the Special Cells property of the Range class.

我不确定这意味着什么或如何解决它.另外我猜这个宏需要调整才能插入 B 列中的超链接文本.

I am not sure what this means or how to fix it. Also I am guessing this macro needs adjusting to be able to insert the hyperlinked text that is in Column B.

感谢您的帮助！PS 在过去的 15 年里，我们一直在手动和每年为 4 个指南进行此操作，每个指南中有超过 100 个问题.我很想找到一种自动化的方法！

Thanks for any help! PS We have been doing this manually and annually for 4 guides with over 100 questions in each guide for the past 15 years. I so want to figure out a way to automate!!

推荐答案

链接中代码的问题是它是为后期绑定而编写的，但仍然使用命名的 Excel 常量.将xlCellTypeLastCell"更改为11".

The problem with the code in the link is that it's written for late binding but nevertheless uses a named Excel constant. Change 'xlCellTypeLastCell' to '11'.

由于您想要超链接问题，请尝试以下方式:

Since you're wanting to hyperlink the questions, try something along the lines of:

Sub HyperlinkQuestions()
Application.ScreenUpdating = False
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, r As Long
Dim StrFnd As String, StrHLnk As String, StrHTxt As String
StrWkBkNm = "C:Users" & Environ("Username") & "DocumentsQuestionLinks.xlsx"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
On Error Resume Next
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(StrWkBkNm, False, True)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit: Set xlApp = Nothing: Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk
    With .Worksheets("Sheet1")
      'Process the F/R data
      For r = 2 To .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
        If Trim(.Range("A" & r)) <> vbNullString Then
          StrFnd = .Range("A" & r).Text
          With .Range("B" & r)
            If .Hyperlinks.Count = 1 Then
              StrHLnk = .Hyperlinks(1).Address
              StrHTxt = .Hyperlinks(1).TextToDisplay
            Else
              StrHLnk = .Text
              StrHTxt = .Text
            End If
          End With
          Call LinkQuestion(StrFnd, StrHLnk, StrHTxt)
        End If
      Next
    End With
  .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
Application.ScreenUpdating = True
End Sub

Sub LinkQuestion(StrFnd As String, StrHLnk As String, StrHTxt As String)
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = StrFnd
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = True
    .Execute
  End With
  Do While .Find.Found
    .Hyperlinks.Add .Duplicate, StrHLnk, , , StrHTxt
    .Start = .Hyperlinks(1).Range.End
    .Find.Execute
  Loop
End With
End Sub

运行HyperlinkQuestions"宏会将您的问题变成超链接.

Running the 'HyperlinkQuestions' macro will turn your questions into hyperlinks.

该宏假设您使用的是存储在您的文档"文件夹中的名为QuestionLinks.xlsx"的 Excel 工作簿以及问题和超链接列表位于 A 列和B，分别是'Sheet1'.

The macro assumes you're using an Excel workbook named 'QuestionLinks.xlsx' stored in your 'Documents' folder and the Question & Hyperlink list are in Columns A & B, respectively, of 'Sheet1'.

这篇关于需要从 MS Excel 的列表中展开 MS Word 中的多个查找和替换以替换带有超链接的文本并修复错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！