excel - 从 excel 更新书签
问题描述
我在 VBA 字中有以下代码
- 选择excel文件
- 使用 excel 单元格值中的值更新 word 中书签的值
一切正常,但不是用 col B 上的值更新 colA 中的书签,而是代码只插入书签。
Function FileOpenDialogBox()
'Display a Dialog Box that allows to select a single file.
'The path for the file picked will be stored in fullpath variable
With Application.FileDialog(msoFileDialogFilePicker)
'Makes sure the user can select only one file
.AllowMultiSelect = False
'Filter to just the following types of files to narrow down selection options
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
'Show the dialog box
.Show
'Store in fullpath variable
fullpath = .SelectedItems.Item(1)
FileOpenDialogBox = fullpath
End With
'MsgBox FileOpenDialogBox
End Function
Sub WorkOnAWorkbook()
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String, msg1 As String
Dim val1, val2 As String
'specify the workbook to work on
WorkbookToWorkOn = FileOpenDialogBox
'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
On Error GoTo Err_Handler
'If you want Excel to be visible, you could add the line: oXL.Visible = True here; but your code will run faster if you don't make it visible
'Open the workbook
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
'Process each of the spreadsheets in the workbook
For Each oSheet In oXL.ActiveWorkbook.Worksheets
'put guts of your code here
' msg = msg & oSheet.Range("A1").Value
If oSheet.Name = "Sheet1" Then
lastrow = oSheet.Cells(oSheet.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
' MsgBox "last used row in col A is " & lastrow
val1 = oSheet.Range("A" & i).Value 'value of the bookmark
val2 = oSheet.Range("B" & i).Value
ActiveDocument.Bookmarks.Add Name:=val1, Range:=Selection.Range
'update bookmark if bookmark exists
If ActiveDocument.Bookmarks.Exists(val1) = True Then
UpdateBookmark (val1), (val2)
'MsgBox i
j = j + 1 'counts number of bookmarks updated
ElseIf ActiveDocument.Bookmarks.Exists(val1) = False Then
k = k + 1 'gives total of bookmarks not found
End If
Next i
End If
'get next sheet
Next oSheet
'Exit Sub
'MsgBox msg, , msg1
If ExcelWasNotRunning Then
oXL.Quit
End If
'Make sure you release object references.
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing
'quit
Call update_all_bookmarks 'update all bookmarks
MsgBox j & " Bookmarks updated!."
Exit Sub
Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & vbNewLine & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If
End Sub
Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String)
Dim BMRange As Range
Set BMRange = ActiveDocument.Bookmarks(BookmarkToUpdate).Range
BMRange.Text = TextToUse
'ActiveDocument.Bookmarks.Add BookmarkToUpdate, BMRange
End Sub
Sub update_all_bookmarks()
' select the document and update the macro
With Selection
.WholeStory
.Fields.Update
.MoveLeft Unit:=wdCharacter, Count:=1
End With
End Sub
Option Explicit
Sub RightClickMenu()
Dim MenuButton As CommandBarButton
With CommandBars("Text")
Set MenuButton = .Controls.Add(msoControlButton)
With MenuButton
.Caption = "Update from excel"
.Style = msoButtonCaption
.OnAction = "WorkOnAWorkbook"
End With
End With
End Sub
Sub ResetRightClick()
Application.CommandBars("Text").Reset
End Sub
以下内容转到我的文档
Private Sub Document_Close()
ResetRightClick
End Sub
Private Sub Document_Open()
Call RightClickMenu
End Sub
任何帮助将不胜感激
解决方案
未经测试,但或多或少应该是您需要做的:
Option Explicit
Sub UpdateBookmarksFromExcelFile()
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String, msg1 As String
Dim bkmk As String, txt As String, doc As Document, i As Long, j As Long, k As Long
WorkbookToWorkOn = FileOpenDialogBox 'specify the workbook to work on
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
On Error GoTo 0
If oXL Is Nothing Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
On Error GoTo Err_Handler
Set doc = ActiveDocument
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
For Each oSheet In oWB.Worksheets
If oSheet.Name = "Sheet1" Then
For i = 1 To oSheet.Cells(oSheet.Rows.Count, "A").End(xlUp).Row
bkmk = oSheet.Range("A" & i).Value 'value of the bookmark
txt = oSheet.Range("B" & i).Value
If Len(bkmk) > 0 Then
If UpdateBookmark(doc, bkmk, txt) Then
j = j + 1 'counts number of bookmarks updated
Else
k = k + 1 'gives total of bookmarks not found
End If
End If
Next i
End If
Next oSheet
oWB.Close False
If ExcelWasNotRunning Then oXL.Quit
MsgBox j & " Bookmarks updated, " & k & " Bookmarks not found."
Exit Sub
Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & vbNewLine & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then oXL.Quit
End Sub
'replace any text in a bookmark in doc with the supplied text: return True if successful
Function UpdateBookmark(doc As Document, BookmarkToUpdate As String, TextToUse As String) As Boolean
Dim BMRange As Range
If doc.Bookmarks.Exists(BookmarkToUpdate) Then
Set BMRange = doc.Bookmarks(BookmarkToUpdate).Range
BMRange.Text = TextToUse
doc.Bookmarks.Add BookmarkToUpdate, BMRange
UpdateBookmark = True
Else
UpdateBookmark = False 'no update
End If
End Function
推荐阅读
- python - python [regex] - 从文件中读取行时搜索功能不起作用
- excel - 从数组中的大数据填充列表框
- flutter - Dart 中通用 List 对象的 runtimeType 检查
- ios - 如果我设置超过 2 个不同通知创建的最大通知数量会发生什么
- r - R ggplot2 geom_line 指定颜色形式的向量返回未知颜色
- django - 从 django 应用程序发送电子邮件在服务器上不起作用
- c# - 聚合异常:Firebase 找不到指定的图像
- python - 在 Pytorch 中转换自定义数据集时出错
- ios - 如何获取与iphone配对的蓝牙设备信息
- linux - GitLab CI/CD 管道在构建 Debian 包时找不到 GCC