从excel更新书签
我在VBA word中有以下代码从excel更新书签,excel,vba,ms-word,bookmarks,Excel,Vba,Ms Word,Bookmarks,我在VBA word中有以下代码 选择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
- 选择excel文件
- 使用excel单元格值中的值更新word中书签的值
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
任何未经测试的帮助都将不胜感激,但或多或少应该是您需要做的:
选项显式
子更新BookMarksFromExcelFile()
Dim-oXL作为Excel.Application
将oWB设置为Excel.工作簿
将oSheet设置为Excel.工作表
变暗为Excel.Range
Dim Excel未作为布尔值运行
将工作簿设置为工作字符串,将msg1设置为字符串
Dim bkmk作为字符串,txt作为字符串,doc作为文档,i作为长,j作为长,k作为长
WorkbookToWorkOn=FileOpenDialogBox'指定要处理的工作簿
出错时继续下一步
Set oXL=GetObject(,“Excel.Application”)
错误转到0
如果oXL什么都不是
ExcelWasNotRunning=True
Set oXL=New Excel.Application
如果结束
关于错误转到错误处理程序
Set doc=ActiveDocument
设置oWB=oXL.Workbooks.Open(文件名:=WorkbookToWorkOn)
对于oWB.工作表中的每个oSheet
如果oSheet.Name=“Sheet1”,则
对于i=1到oSheet.Cells(oSheet.Rows.Count,“A”).End(xlUp.Row
bkmk=oSheet.Range(“A”&i).Value”书签的值
txt=oSheet.Range(“B”和i).值
如果Len(bkmk)>0,则
如果UpdateBookmark(doc、bkmk、txt),则
j=j+1'统计已更新书签的数量
其他的
k=k+1'给出未找到的书签总数
如果结束
如果结束
接下来我
如果结束
下一个奥希特
关闭错误
如果Excel未运行,则oXL.退出
MsgBox j&“书签已更新,&k&”未找到书签
出口接头
错误处理程序:
MsgBox WorkbookToWorkOn&“导致了一个问题”&vbNewLine&Err.Description,vbCritical_
错误:&错误号
如果Excel未运行,则oXL.退出
端接头
'用提供的文本替换文档中书签中的任何文本:如果成功,则返回True
函数UpdateBookmark(文档为文档,书签更新为字符串,文本使用为字符串)为布尔值
变暗BMRANGAS范围
如果存在doc.Bookmarks.(bookmarktoopdate),则
设置BMRange=doc.Bookmarks(bookmarktoopdate).Range
BMRange.Text=TextToUse
doc.Bookmarks.addbookmarktoopdate,BMRange
UpdateBookmark=True
其他的
UpdateBookmark=False“无更新”
如果结束
端函数
您的代码似乎将Sheet1上定义的所有书签添加到文档中的同一位置(当前选择)?我的目标是更改Sheet1中A列上有名称、B列上有值的书签,但如果文档中不存在书签,则应跳过它?您的代码创建书签,但如果必须添加书签,则不清楚应该在何处创建书签。