需要从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列中列出了所有问题编号,在B列中还列出了也是超链接的实际问题.我想用电子表格B栏中相应的超链接问题替换Word文档中的每个问题#.
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.
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") & "\Documents\QuestionLinks.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.
该宏假定您正在使用存储在文档"文件夹中的Excel工作簿"QuestionLinks.xlsx"以及问题与解决方案".超链接列表在A列和&列中.分别为"Sheet1"的B.
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屋!