Stop multiple pastes at bookmark

chipnputt · #1 07-12-2011, 04:37 PM

I have been working with VBA in Access, Excel and currently Word. I have an excel spreadsheet that is used to organize golfing foursomes on a daily basis. From here I export the necessary data to a word document and then transfer that doc through FTP to the Associations web site. I use the following code to[code]
With ActiveDocument
'Identify current Bookmark range and insert text
If .Bookmarks.Exists(BmkNm) Then

.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, DataType:=wdPasteHTML, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
This code works but the second time it is run, the information is added after the last paste. I have searched for a way to delete the previous information if any and then paste the text to no avail. Any suggestions would be appreciated.

macropod · #2 07-12-2011, 06:57 PM

Hi chipnputt,

This isn't as straightforward as one might expect. Try something along the lines of:

Code:

Sub UpdateBookMark()
Dim BmkNm As String, NewTxt As String, BmkRng As Range
BmkNm = InputBox("Bookmark Name")
NewTxt = InputBox("New Bookmark Text")
With ActiveDocument
  If .Bookmarks.Exists(BmkNm) Then
    Set BmkRng = .Bookmarks(BmkNm).Range
    BmkRng.Text = NewTxt
    .Bookmarks.Add BmkNm, BmkRng
  Else
    MsgBox "Bookmark: " & BmkNm & " not found."
  End If
End With
Set BmkRng = Nothing
End Sub

chipnputt · #3 07-13-2011, 11:33 AM

Hi Paul -

Thank you for the code suggestion but I do not want to enter the data through the message box. The information is readily available and I am trying to automate it with the click of a button. There are four bookmarks to be updated for date, course, time and teams. The first three work perfectly, the four (teams) is the problem child. In order to give you a feel for the programming the following 2 subs are used to transfer the data. As I stated earlier, the first three bookmarks are wordwrapped types and the fourth is embedded an imbedded type. I have tried linking the teams from excel and that works fine. The problem is that the data is not there when the file is copied through FTP to the host website. Then I went to pastespecial which kept the formatting (text coloring, underlining and bold) - perfect. Schedules get changed almost daily if not hourly and when I make the necessary updates and transfer the data is when the problem occurs. I need help with deleting the existing information at the bookmark and then pasting in the text at the bookmark. I have included the two UDF subs I am using, any suggestions would be appreciated.

Code:

Sub ExportToWord()
Dim wdApp As Word.Application
Dim WdDoc As Word.Document
Dim DaySheet As String, BmDateName As String, BmTimeName As String, _
BmCourseName As String, BmTeamName As String, Courses As String
Dim MondayDate As Date, TuesdayDate As Date, WednesdayDate As Date, _
ThursdayDate As Date, FridayDate As Date, SaturdayDate As Date
Dim Prompt As String, TeamRange As String, BmDate As String, BmTime As String, _
BmCourse As String, FNine As String, _
BNine As String, Title As String, BmkNm As String
Dim myRange As Range, cell As Range, BmTeam As Excel.Range
Dim str
'Turn some stuff off while the macro is running
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
On Error Resume Next
Set wdApp = CreateObject("Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
End If
wdApp.Documents.Open "C:\Users\Sal\Desktop\coxgroup.html"
wdApp.Visible = True
On Error GoTo 0
For i = 2 To 7
  If i = 2 Then
    DaySheet = "Monday"
  End If
  If i = 3 Then
    DaySheet = "Tuesday"
  End If
  If i = 4 Then
    DaySheet = "Wednesday"
  End If
  If i = 5 Then
    DaySheet = "Thursday"
  End If
  If i = 6 Then
    DaySheet = "Friday"
  End If
  If i = 7 Then
    DaySheet = "Saturday"
  End If
  ' define bookmark names
  BmDateName = DaySheet & "Date"
  BmCourseName = DaySheet & "Course"
  BmTimeName = DaySheet & "Time"
  BmTeamName = DaySheet & "Teams"
  Courses = Worksheets(DaySheet).Range("D24")
  FNine = Proper(CutFirstWord(Courses))
  BNine = Proper(CutLastWord(Courses))
  ' define bookmark text
  BmCourse = FNine & " - " & BNine
  BmDate = " " & ThisWorkbook.Worksheets("Sign-Ups").Cells(1, i)
  BmDate = Format(BmDate, "dddd - mmmm d, yyyy")
  If Worksheets(DaySheet).Cells(24, 1) = "Y" Then
    BmTime = Format(Worksheets("Sign-Ups").Cells(3, i), "h:m AM/PM") & " SHOTGUN"
  Else
    BmTime = "TEE TIMES"
  End If
  ' send text data to word doc
  Call WB(BmDateName, BmDate)
  Call WB(BmCourseName, BmCourse)
  Call WB(BmTimeName, BmTime)
  ' define team data
  BmkNm = BmTeamName
  Set BmTeam = Worksheets(DaySheet).Range(BmTeamName)
  Worksheets(DaySheet).Activate
  Worksheets(DaySheet).Range(BmTeamName).Select
  Selection.Copy
  ' paste team data into word doc
  With ActiveDocument
    'Identify current Bookmark range and insert text
    If .Bookmarks.Exists(BmkNm) Then
      .Bookmarks(BmkNm).Range.PasteSpecial Link:=False, DataType:=wdPasteHTML, _
      Placement:=wdInLine, DisplayAsIcon:=False
    End If
  End With
  Application.CutCopyMode = False
Next i
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
ActiveDocument.Unprotect
ActiveDocument.SaveAs ("C:\Users\Sal\Desktop\coxgroup.html")
wdApp.Quit
'Turn everything back on
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.StatusBar = False
End Sub

This sub is used in the above sub for the first 3 bookmarks - works perfectly!!

Code:

Sub WB(ByVal BmName As String, ByVal data As String)
If ActiveDocument.Bookmarks.Exists(BmName) Then
  Dim r As Object
  Set r = ActiveDocument.Bookmarks(BmName).Range
  r.Text = data
  ActiveDocument.Bookmarks.Add BmName, r
Else
  Debug.Print "Bookmark not found: " & BmName
End If
End Sub

macropod · #4 07-14-2011, 05:05 AM

Hi chipnputt,

Quote:

I do not want to enter the data through the message box

Then don't! The code I posted is a stand-alone routine demonstrating how to update a bookmarked range. Simply adapt that to your needs.

chipnputt · #5 07-14-2011, 12:29 PM

I have experience in VBA with Access and Excel, I am a novice with word. I have a routine that updates bookmarks in word from a routine in an excel spreadsheet. I keep getting a compile error "Expecting Function or variable". in the code below

Code:

Sub UpdateBookMark()
Dim BmkNm As String, NewTxt As String, BmkRng As Object
BmkNm = "MondayTeams"
Worksheets("Monday").Range("H1:L2").Select
Selection.Copy
With ActiveDocument
  If .Bookmarks.Exists(BmkNm) Then
    Set BmkRng = .Bookmarks(BmkNm).Range
    BmkRng.Text = .Bookmarks(BmkNm).Range.PasteSpecial(DataType:=wdPasteHTML, Placement:=wdInLine, DisplayAsIcon:=False)
    .Bookmarks.Add BmkNm, BmkRng
  Else
    MsgBox "Bookmark: " & BmkNm & " not found."
  End If
End With
Set BmkRng = Nothing
End Sub

The error highlights ".PasteSpecial" as the problem area. Does anyone know how to correct the error. The reason for using the PasteSpecial is that the formatting and layout remains the same as it is in the spreadsheet.

Thanking you in advance....

macropod · #6 07-14-2011, 03:28 PM

Hi chipnputt,

That's not how you're supposed to do it! You don't need to select anything, and you don't need to copy & paste. Try:

Code:

Sub UpdateBookMark()
Dim BmkNm As String, NewTxt As String, BmkRng As Object
BmkNm = "MondayTeams"
NewTxt = Worksheets("Monday").Range("H1:L2").Value
With ActiveDocument
  If .Bookmarks.Exists(BmkNm) Then
    Set BmkRng = .Bookmarks(BmkNm).Range
    BmkRng.Text = NewTxt
    .Bookmarks.Add BmkNm, BmkRng
  Else
    MsgBox "Bookmark: " & BmkNm & " not found."
  End If
End With
Set BmkRng = Nothing
End Sub

PS: When posting material relating to a discussion already under way, please use the same thread.

macropod · #7 07-14-2011, 03:56 PM

Hi chipnputt,

I've had a quick look at your 'ExportToWord' sub. There are some odd things there, plus some inefficiencies that could be improved upon. For example:
1. Why do you have:

Code:

If Err.Number <> 0 Then 'Word isn't already running
End If

and:

Code:

ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
ActiveDocument.Unprotect

Neither of these seem to do anything useful.

2. The code:

Code:

  If i = 2 Then
    DaySheet = "Monday"
  End If
  If i = 3 Then
    DaySheet = "Tuesday"
  End If
  If i = 4 Then
    DaySheet = "Wednesday"
  End If
  If i = 5 Then
    DaySheet = "Thursday"
  End If
  If i = 6 Then
    DaySheet = "Friday"
  End If
  If i = 7 Then
    DaySheet = "Saturday"
  End If

would be simpler and more efficicent as:

Code:

  Select Case i
    Case i = 2: DaySheet = "Monday"
    Case i = 3: DaySheet = "Tuesday"
    Case i = 4: DaySheet = "Wednesday"
    Case i = 5: DaySheet = "Thursday"
    Case i = 6: DaySheet = "Friday"
    Case i = 7: DaySheet = "Saturday"
  End Select

and, notwithstanding that I've demonstrated that copying & pasting is unnecessary for what you're doing:

Code:

  Worksheets(DaySheet).Activate
  Worksheets(DaySheet).Range(BmTeamName).Select
  Selection.Copy

would be simpler and more efficicent as:

Code:

Worksheets(DaySheet).Range(BmTeamName).Copy

chipnputt · #8 07-15-2011, 01:12 PM

Hi macropod

Thank you for your time in going through the sub, finding the unnecessary code and the suggestions for better efficiency. You also suggested a stand alone sub that transfers the data to the bookmark instead of a paste.
I have update my sub with your suggestions, and all is fine. I tried to utilize the UpdateBookMark sub and got errors due to mismatched data types. Finally got it to transfer but problems still endured. The data was not formatted as I wanted and it was placed before the bookmark. This was my initial problem with the pastespecial code I started with. What I am trying to do is transfer the data from several cells, as is formatted to a bookmark in word, replacing the data in the bookmark and keeping the bookmark. There is a sub I use in my ExportToWord code called WB and it is basically the same as your standalone and it works great but anytime it is used it is a single text entry. I am aware that you stated selection and paste is not the way to do it but initially (given the bookmark is empty) it does what I want to do. The help I am looking for is either.
Remove the paste that was done BEFORE the bookmark, allowing the current pastespecial to be done in its place OR preferably I would like to have it inside the wordwrapped bookmark, replacing anything currently in there.. In addition to the previous changes, I have set Options.ReplaceSelection = True.
I would like to thank you for your patience, the help you have given and any further assistance!

macropod · #9 07-15-2011, 03:48 PM

Hi chipnputt,

OK, if you want to preserve the source formatting, copy/paste will be needed. In that case, try:

Code:

Sub ExportToWord()
'Turn some stuff off while the macro is running
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim DaySheet As String, BmDateName As String, BmTimeName As String
Dim BmCourseName As String, BmTeamName As String, Courses As String
Dim BmDate As String, BmTime As String
Dim BmCourse As String, FNine As String, BNine As String
On Error Resume Next
Dim wdApp As Word.Application
Dim WdDoc As Word.Document
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set WdDoc = wdApp.Documents.Open("C:\Users\Sal\Desktop\coxgroup.html")
On Error GoTo 0
For i = 2 To 7
  Select Case i
    Case i = 2: DaySheet = "Monday"
    Case i = 3: DaySheet = "Tuesday"
    Case i = 4: DaySheet = "Wednesday"
    Case i = 5: DaySheet = "Thursday"
    Case i = 6: DaySheet = "Friday"
    Case i = 7: DaySheet = "Saturday"
  End Select
  ' define bookmark names
  BmDateName = DaySheet & "Date"
  BmCourseName = DaySheet & "Course"
  BmTimeName = DaySheet & "Time"
  BmTeamName = DaySheet & "Teams"
  Courses = Worksheets(DaySheet).Range("D24")
  FNine = Proper(CutFirstWord(Courses))
  BNine = Proper(CutLastWord(Courses))
  ' define bookmark text
  BmCourse = FNine & " - " & BNine
  BmDate = " " & ThisWorkbook.Worksheets("Sign-Ups").Cells(1, i)
  BmDate = Format(BmDate, "dddd - mmmm d, yyyy")
  If Worksheets(DaySheet).Cells(24, 1) = "Y" Then
    BmTime = Format(Worksheets("Sign-Ups").Cells(3, i), "h:m AM/PM") & " SHOTGUN"
  Else
    BmTime = "TEE TIMES"
  End If
  ' send text data to word doc
  Call WB(BmDateName, BmDate)
  Call WB(BmCourseName, BmCourse)
  Call WB(BmTimeName, BmTime)
  Worksheets(DaySheet).Range(BmTeamName).Copy
  ' paste team data into word doc
  With WdDoc
    'Identify current Bookmark range and insert text
    If .Bookmarks.Exists(BmTeamName) Then
      Set BmkRng = .Bookmarks(BmTeamName).Range
      BmkRng.PasteSpecial Link:=False, DataType:=wdPasteHTML, _
      Placement:=wdInLine, DisplayAsIcon:=False
      BmkRng.End = BmkRng.End + Len(Worksheets(DaySheet).Range(BmTeamName).Value)
      .Bookmarks.Add BmTeamName, BmkRng
    Else
      MsgBox "Bookmark: " & BmTeamName & " not found."
    End If
  End With
  Application.CutCopyMode = False
Next i
WdDoc.Close SaveChanges:=True, OriginalFormat:=1
wdApp.Quit
Set WdDoc = Nothing: Set wdApp = Nothing
'Turn everything back on
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.StatusBar = False
End Sub

Note: I've cleaned up the code somewhat, deleting numerous unused/redundant variables and making use of one that was declared but not used.

chipnputt · #10 07-16-2011, 05:43 PM

Hi macropod

I appreciate the clean up and redundancies that you took time out of your schedule to show me. I have done the same to my code and executed it. Thank you for your time, effort and patience. Problem solved!!!

Sal

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA to insert Bookmark	rockwellsba	Word VBA	2	05-31-2011 01:07 AM
Help with PPT AddIn that pastes slides into another presentation	matt.wilson	PowerPoint	0	01-05-2011 03:28 PM
Controlling Style when a user pastes into a form	Cris0205	Word	0	08-05-2010 04:33 PM
Can you stop multiple calendars from fading?	JohnGalt	Outlook	2	08-05-2010 09:06 AM
Word only pastes plain text	seskanda	Word	6	02-19-2010 10:01 AM