Data from Excel to Word 07 Bookmark

[bigal.nz]

Hi All,

I am trying to create a context menu option, so that when you right click on a cell and invoke the context menu "Create Report" it opens a word report, and populates 4 bookmarks with information from the current row.

I have copied various bits of code I found on the internet to get I think close to a solution, if someone can have a look at let me know where I am going wrong would be great:











Sub AddToCellMenu()
Dim ContextMenu As CommandBar
Dim MySubMenu As CommandBarControl

'Delete the controls first to avoid duplicates
Call DeleteFromCellMenu

'Set ContextMenu to the Cell menu
Set ContextMenu = Application.CommandBars("Cell")

'Add one built-in button(Save = 3)to the cell menu
ContextMenu.Controls.Add Type:=msoControlButton, ID:=3, Before:=1

'Add one custom button to the Cell menu
With ContextMenu.Controls.Add(Type:=msoControlButton, Before:=2)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "Report"
.FaceId = 7
.Caption = "Report 1"
.Tag = "My_Cell_Control_Tag"
End With
End Sub

Sub DeleteFromCellMenu()
Dim ContextMenu As CommandBar
Dim ctrl As CommandBarControl

'Set ContextMenu to the Cell menu
Set ContextMenu = Application.CommandBars("Cell")

'Delete custom controls with the Tag : My_Cell_Control_Tag
For Each ctrl In ContextMenu.Controls
If ctrl.Tag = "My_Cell_Control_Tag" Then
ctrl.Delete
End If
Next ctrl

'Delete built-in Save button
On Error Resume Next
ContextMenu.FindControl(ID:=3).Delete
On Error GoTo 0
End Sub

Sub Report()
Dim CaseRange As Range
Dim CalcMode As Long
Dim cell As Range
Dim wordapp As Object
Dim worddoc As Object

On Error Resume Next
Set CaseRange = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
On Error GoTo 0
If CaseRange Is Nothing Then Exit Sub

Set wordapp = CreateObject("Word.Application")
Set worddoc = wordapp.Documents.Open(Filename:="C:\Users\Al\My Documents\Report.docx")
wordapp.Visible = True

For Each cell In CaseRange.Cells
worddoc.Bookmark("FOLIO").Range.Text = "Test"
worddoc.Bookmark("NAME").Range.Text = Cells(cell.Row, "C")
worddoc.Bookmark("RECORD").Range.Text = Cells(cell.Row, "B")
worddoc.Bookmark("DATE").Range.Text = Cells(cell.Row, "D")
MsgBox Cells(cell.Row, "A")
Next cell

MsgBox ("Finish")
wordapp.Quit
Set wordapp = Nothing
Set worddoc = Nothing
End Sub



Something is wrong with the lines:



worddoc.Bookmarks("FOLIO").Range.Text = ws.Cells(A & cell.Row).Value


Which throws error Runtime error 438
Object doesnt support this property or method

Could someone please help me out?

Thanks!!

-Al