Word stops copying/cutting to clipboard

[bibliostat]

I have a macro that would run fine in Word 2010. I upgraded to Word 2013 and now it not longer works. The overview is that I use a program NoteMaster on my phone to take pictures of a construction site and annotate them. The app creates a word document on Drop box. My code imports these pictures and text into a report format. In my code, I'm accessing the inline shapes collection and cutting and pasting it from one location to the next. However after about 3 or 4 pictures, it just stops cutting the pictures to the clipboard from VBA. I picked up clipboard viewers and the picture doesn't make it to the clipboard. I can cut and paste from the application and VBA will still cut and paste text just not the pictures.

Here's the code:

For i = 1 To bDoc.InlineShapes.Count

'this section inserts a row in my report table for each picture, then goes and gets the text right below the picture and pastes it in the right column of the table.
If i = bDoc.InlineShapes.Count Then
iCurRow = tbl.Rows.Count
Set rng = bDoc.Range(Start:=bDoc.InlineShapes(i).Range.Start, End:=bDoc.Paragraphs(bDoc.Paragraphs.Count).Range.End)
Else
tbl.Rows.Add (tbl.Rows(tbl.Rows.Count))
iCurRow = tbl.Rows.Count - 1
Set rng = bDoc.Range(Start:=bDoc.InlineShapes(i).Range.Start, End:=bDoc.InlineShapes(i + 1).Range.End)
End If
If rng.Characters.Count > 4 Then
Set rng2 = bDoc.Range(Start:=rng.Paragraphs(2).Range.Start, End:=rng.Paragraphs(rng.Paragraphs.Count - 1).Range.End)
rng2.Cut
tbl.Cell(iCurRow, 2).Range.PasteSpecial datatype:=wdPasteText
End If
tbl.Cell(iCurRow, 2).SetWidth ColumnWidth:=InchesToPoints(2.36), rulerstyle:=wdAdjustNone
n = tbl.Cell(iCurRow, 2).LeftPadding

'this section resizes the pictures to 3" or 4" wide depending on if the picture is portrait or landscape
If bDoc.InlineShapes(i).Height > bDoc.InlineShapes(i).Width Then
bDoc.InlineShapes(i).Height = InchesToPoints(4)
bDoc.InlineShapes(i).Width = InchesToPoints(3)
Else
bDoc.InlineShapes(i).Height = InchesToPoints(3)
bDoc.InlineShapes(i).Width = InchesToPoints(4)
End If

'This section cuts the picture and then goes to the table and pastes it in the correct column and row. But this is where the code breaks after 3 or 4 iterations. It just stops cutting the picture to the clipboard. So that the next line after the cut, errors out. I have tried just doing a normal paste as well and that doesn't work either.
bDoc.InlineShapes(i).Range.Cut
tbl.Cell(iCurRow, 1).Range.PasteSpecial datatype:=wdPasteBitmap
tbl.Cell(iCurRow, 1).SetWidth ColumnWidth:=InchesToPoints(4.25), rulerstyle:=wdAdjustNone
Next


Any ideas on why it quits cutting/copying? It used to work just fine in Word 2010. Started breaking in Word 2013. Appreciate any help. Thanks!

[Dave]

'module code.....
'clear clipboard
Option Explicit
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Public Function ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Function

'your code fix
For i = 1 To bDoc.InlineShapes.Count
'this section inserts a row in my report table for each picture, then goes and gets the text right below the picture and pastes it in the right column of the table.
If i = bDoc.InlineShapes.Count Then
iCurRow = tbl.Rows.Count
Set rng = bDoc.Range(Start:=bDoc.InlineShapes(i).Range.Start, End:=bDoc.Paragraphs(bDoc.Paragraphs.Count).Range.End)
Else
tbl.Rows.Add (tbl.Rows(tbl.Rows.Count))
iCurRow = tbl.Rows.Count - 1
Set rng = bDoc.Range(Start:=bDoc.InlineShapes(i).Range.Start, End:=bDoc.InlineShapes(i + 1).Range.End)
End If
If rng.Characters.Count > 4 Then
Set rng2 = bDoc.Range(Start:=rng.Paragraphs(2).Range.Start, End:=rng.Paragraphs(rng.Paragraphs.Count - 1).Range.End)
rng2.Cut
tbl.Cell(iCurRow, 2).Range.PasteSpecial DataType:=wdPasteText
Call ClearClipboard
End If
tbl.Cell(iCurRow, 2).SetWidth ColumnWidth:=InchesToPoints(2.36), rulerstyle:=wdAdjustNone
n = tbl.Cell(iCurRow, 2).LeftPadding
'this section resizes the pictures to 3" or 4" wide depending on if the picture is portrait or landscape
If bDoc.InlineShapes(i).Height > bDoc.InlineShapes(i).Width Then
bDoc.InlineShapes(i).Height = InchesToPoints(4)
bDoc.InlineShapes(i).Width = InchesToPoints(3)
Else
bDoc.InlineShapes(i).Height = InchesToPoints(3)
bDoc.InlineShapes(i).Width = InchesToPoints(4)
End If
HTH. Dave

[bibliostat]

Dave,

Thank you. I have inserted that code and the macro is now calling the clear clipboard function. I am using a program called free clipboard viewer to keep an eye on what's actually on the clipboard. I see the code go through and grab the first line of text, then it clears it using the new function, it cuts and pastes the first picture as expected. On the next iteration, it cuts and pastes the text and clears the clipboard as expected. But when it goes to cut the picture--inlineshape(2)--I can see the picture disappear from the document but the clipboard is blank in the clipboard viewer program and when I go to execute the next line to paste, it throws an error. It's like the picture got cut to a different clipboard that I can't access or deleted or something. I don't know where it goes but I can't seem to access it with VBA. This is consistent with what it had been doing but its doing it on the 2nd iteration now instead of the 4th. Any more ideas on what might be happening?

Nate

[Dave]

Not really. Maybe trial using copy instead of cut. My thoughts were that your pics/etc were over filling the clipboard and causing the crash. Where's the code for cutting and pasting the pics or am I missing something? Dave

[bibliostat]

Appreciate your help. I tried copying instead of cutting as you suggested and it didn't seem to make any difference. The code for cutting and pasting is the last 4 lines of the original post:

bDoc.InlineShapes(i).Range.Cut 'here's where I cut the picture.
tbl.Cell(iCurRow, 1).Range.PasteSpecial datatype:=wdPasteBitmap ' here's where I past the picture into the specified row and column of the table in the formatted report.
tbl.Cell(iCurRow, 1).SetWidth ColumnWidth:=InchesToPoints(4.25), rulerstyle:=wdAdjustNone 'this line just adjusts the width of the table column
Next

[bibliostat]

The original code didn't use the pastespecial method. It used a simple past method. I went to pastespecial when it started breaking in Word 2013 but it doesn't seem to make any difference.

[bibliostat]

As soon as I execute bDoc.InlineShapes(i).Range.Cut (stepping through the code), I can see the picture that I'm selecting disappear from the document. However, the picture does not show up on the clipboard viewer program. The text always does and the first time I iterate through it, I can see the picture in clipboard viewer. But then for the second iteration, text yes but the pictures won't. If I leave the code and go to Word, and use my mouse to cut/copy one of the picture, I can see it on the clipboard and it will paste just fine. It just seems to be VBA that won't work. And the pictures do get cut from the document. I just don't know where they've gone so that I can access them with my code (or even MS Word using the edit/paste menu command)--it doesn't seem to be on the clipboard at all.

[Dave]

Some how I missed the pic paste part before. Trial removing the Call ClearClipboard from where it is an putting it at the end of the loop before next. Maybe it's the ConvertToShape thing. I really don't like the structure of your code using the number of pics as part of the loop counter. Anyways, trial making the code change. If that doesn't work, you must almost have enough posts to post a sample document. My understanding is that you just want to organize the document into a table containing pics in 1 column and descriptive text (originally below the pic) in a 2nd column.... and have it work in Word 2013. I'm fairly sure it can be done. Dave

[bibliostat]

'The purpose of the code is to import a construction field observation document that contains pictures and captions in an MS Word document
'into a formatted report template for distribution to stake holders of that construction project.

Sub ImportNoteMaster()
Dim i As Integer, n As Integer, iCurRow As Integer
Dim tbl As Table
Dim rng As Range, rng2 As Range
Dim strPath As String, strInfo As String, strPrjName As String, strLastReport, strTemplateName As String
Dim bDoc As Document
Dim fd As Object, fFiles As Object, f As Object, oFS As Object

Set bDoc = Word.Application.ActiveDocument

'As a convenience, location the project folder of the project being reported on.
'Search through the previous reports to pull the project name and
'increment the report number by 1 based on the number of previous report files in the folder.

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.InitialFileName = "X:\"
fd.Title = "Choose the project folder for this report"
If fd.Show = -1 Then
strPath = fd.SelectedItems(1)
End If

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFS = oFS.getfolder(strPath)

n = 0
For Each f In oFS.Files
If InStr(1, f.Name, "Construction Observation Report") > 0 And f.Type = "Microsoft Word Document" Then


n = n + 1
strLastReport = f.Name

End If
Next

'When the last file is found, open it up and pull out the header information for inclusion in the latest report
If n > 0 Then
Word.Application.Documents.Open (strPath & "\" & strLastReport)
strPrjName = Clean(ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Tab les(1).Cell(2, 1))
Else
strPrjName = InputBox("What project is this report for?", "Project Name")
End If

ActiveDocument.Close

bDoc.Activate

'Write the project information in the report temple for the report that is being worked out
bDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Tables(1).Cell(2, 1).Range.Text = strPrjName
bDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = strPrjName & Chr(13) & "Construction Observation Report"

strInfo = n + 1
If Len(strInfo) = 1 Then strInfo = "0" & strInfo
bDoc.Range(Start:=38, End:=40) = strInfo

'Go get the construction field observation report that contains pictures and captions. It was created by the mobile app Notemaster
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "C:\Users\nate.peg\Dropbox\Apps\NoteMaster\Work"
fd.Title = "Choose a NoteMaster document to import"
If fd.Show = -1 Then
strPath = fd.SelectedItems(1)
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFS = oFS.getfile(strPath)
strInfo = Format(oFS.datecreated, "mmm d, yyyy")
End If

With bDoc.Content.Find
.Text = "Date"
.Replacement.Text = strInfo
.Execute Replace:=wdReplaceAll
End With

'This code copies all the pictures and captions from the Word document created by Notemaster into the current report template document
'and pasted below a table.
'The table contains several rows containing bullet points with information about the construction project current status, construction issues,
'upcoming schedule, etc. The balance of the document is dedicated for construction pictures. The format is two columns with the picture in the left column and its caption and description of the picture in the right column.
'Because the number of pictures from week to week and for project to project is variable, the template contains a single row as a placeholder for pictures. The VBA code inserts a row in the table for each picture in the report that week for that project.
'At this point in the code, all of the pictures to be formatted pasted below the table. The pictures and captions are still raw and the code will one by one bring each picture up, put it in its own row with corresponding caption, and resize it to fit well in the document.

Word.Application.Documents.Open (strPath)
ActiveDocument.Content.Select
Selection.Copy
ActiveDocument.Close

'This dumps all the pictures and text from the Notemaster document into the current report template document
Set tbl = bDoc.Tables(1)
tbl.Select
Selection.Move
Selection.Paste

'Count how many pictures there are to deal with and iterate through each one cutting and pasting the caption and the picture into a newly 'inserted row in the report template table.
n = bDoc.InlineShapes.Count
For i = 1 To n

'Insert a new row into the report table for a picture and its caption
If i = n Then


iCurRow = tbl.Rows.Count
Set rng = bDoc.Range(Start:=bDoc.InlineShapes(i).Range.Start, End:=bDoc.Paragraphs(bDoc.Paragraphs.Count).Range.End)

Else


tbl.Rows.Add (tbl.Rows(tbl.Rows.Count))
iCurRow = tbl.Rows.Count - 1
Set rng = bDoc.Range(Start:=bDoc.InlineShapes(i).Range.Start, End:=bDoc.InlineShapes(i + 1).Range.End)

End If
'Make sure there is actually a caption with the picture. Usually there are 2-3 paragraph characters so there should be at least 4
'characters in the selection. Cut the text and paste it into the table row above, right column
If rng.Characters.Count > 4 Then


Set rng2 = bDoc.Range(Start:=rng.Paragraphs(2).Range.Start, End:=rng.Paragraphs(rng.Paragraphs.Count - 1).Range.End)
rng2.Cut
tbl.Cell(iCurRow, 2).Range.PasteSpecial datatype:=wdPasteText

End If
tbl.Cell(iCurRow, 2).SetWidth ColumnWidth:=InchesToPoints(2.36), rulerstyle:=wdAdjustNone
n = tbl.Cell(iCurRow, 2).LeftPadding

'Resize the picture to fit. Checks to see if the picture is landscape or portrait orientation
If bDoc.InlineShapes(i).Height > bDoc.InlineShapes(i).Width Then


bDoc.InlineShapes(i).Height = InchesToPoints(4)
bDoc.InlineShapes(i).Width = InchesToPoints(3)

Else


bDoc.InlineShapes(i).Height = InchesToPoints(3)
bDoc.InlineShapes(i).Width = InchesToPoints(4)

End If

'cut the picture and paste it into the table above
bDoc.InlineShapes(i).Range.Cut 'Here's where it breaks. After 4 iterations stops cutting to the clipboard. Nothing is there and it throws an error when I attempt to paste it on the next line.
tbl.Cell(iCurRow, 1).Range.PasteSpecial datatype:=wdPasteBitmap
Call ClearClipboard
tbl.Cell(iCurRow, 1).SetWidth ColumnWidth:=InchesToPoints(4.25), rulerstyle:=wdAdjustNone
Next

'There are a bunch of paragraph codes left over after moving all the pictures. This section selects them and deletes them.
tbl.Select
n = Selection.Paragraphs.Count
Selection.MoveDown
Selection.MoveDown unit:=wdParagraph, Count:=bDoc.Paragraphs.Count - n, Extend:=wdExtend
Selection.Delete


Set fd = Nothing
Set fFiles = Nothing
Set f = Nothing
Set oFS = Nothing


End Sub

[Dave]

I trimmed the code down so anyone can trial. I put the Ogden data file in a folder named "Test" in the "C" drive. I added a clear the clipboard after the initial paste. Your new code has n also equal to left table padding so I commented that out. I've had past problems with the inline shape count when pasting but it seems that cut and paste maintains the same inline shape count (which it should). Anyways, this code works fine for me using office 2010. I did google something about running 2013 Word files in compatiblity mode and the need for conversion. Hope this helps you arrive at a solution. Dave

Option Explicit
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Public Function ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Function
Sub ImportNoteMaster()
Dim i As Integer, n As Integer, iCurRow As Integer
Dim tbl As Table
Dim rng As Range, rng2 As Range
Dim strPath As String, strInfo As String, strPrjName As String, strLastReport, strTemplateName As String
Dim bDoc As Document
Dim fd As Object, fFiles As Object, f As Object, oFS As Object

strPath = "C:\Test\Ogden 12-2 - copy.docx"
Word.Application.Documents.Open (strPath)
ActiveDocument.Content.Select
Selection.Copy
ActiveDocument.Close
Set bDoc = Word.Application.ActiveDocument
Set tbl = bDoc.Tables(1)
tbl.Select
Selection.Move
Selection.Paste
Call ClearClipboard
n = bDoc.InlineShapes.Count
For i = 1 To n
'Insert a new row into the report table for a picture and its caption
If i = n Then
iCurRow = tbl.Rows.Count
Set rng = bDoc.Range(Start:=bDoc.InlineShapes(i).Range.Start, End:=bDoc.Paragraphs(bDoc.Paragraphs.Count).Range.End)
Else
tbl.Rows.Add (tbl.Rows(tbl.Rows.Count))
iCurRow = tbl.Rows.Count - 1
Set rng = bDoc.Range(Start:=bDoc.InlineShapes(i).Range.Start, End:=bDoc.InlineShapes(i + 1).Range.End)
End If
'Make sure there is actually a caption with the picture. Usually there are 2-3 paragraph characters so there should be at least 4
'characters in the selection. Cut the text and paste it into the table row above, right column
If rng.Characters.Count > 4 Then
Set rng2 = bDoc.Range(Start:=rng.Paragraphs(2).Range.Start, End:=rng.Paragraphs(rng.Paragraphs.Count - 1).Range.End)
rng2.Cut
tbl.Cell(iCurRow, 2).Range.PasteSpecial datatype:=wdPasteText
End If
tbl.Cell(iCurRow, 2).SetWidth ColumnWidth:=InchesToPoints(2.36), rulerstyle:=wdAdjustNone
'n = tbl.Cell(iCurRow, 2).LeftPadding
'Resize the picture to fit. Checks to see if the picture is landscape or portrait orientation
If bDoc.InlineShapes(i).Height > bDoc.InlineShapes(i).Width Then
bDoc.InlineShapes(i).Height = InchesToPoints(4)
bDoc.InlineShapes(i).Width = InchesToPoints(3)
Else
bDoc.InlineShapes(i).Height = InchesToPoints(3)
bDoc.InlineShapes(i).Width = InchesToPoints(4)
End If
'cut the picture and paste it into the table above
bDoc.InlineShapes(i).Range.Cut 'Here's where it breaks. After 4 iterations stops cutting to the clipboard. Nothing is there and it throws an error when I attempt to paste it on the next line.
tbl.Cell(iCurRow, 1).Range.PasteSpecial datatype:=wdPasteBitmap
tbl.Cell(iCurRow, 1).SetWidth ColumnWidth:=InchesToPoints(4.25), rulerstyle:=wdAdjustNone
Call ClearClipboard
Next
tbl.Select
n = Selection.Paragraphs.Count
Selection.MoveDown
Selection.MoveDown unit:=wdParagraph, Count:=bDoc.Paragraphs.Count - n, Extend:=wdExtend
Selection.Delete
Set fd = Nothing
Set fFiles = Nothing
Set f = Nothing
Set oFS = Nothing
End Sub
Function Clean(strText) As String

Dim a$, b$, c$, i As Integer

a$ = strText
For i = 1 To Len(a$)
b$ = Mid(a$, i, 1)
If Asc(b$) > 31 Then
c$ = c$ & b$
End If
Next i
Clean = Trim(c$)

End Function

[Dave]

Anyone with Word 2013 and a few minutes to contribute to biliostat? Here's a link that might be relevant. Dave
http://www.mrexcel.com/forum/general-excel-discussion-other-questions/728053-ms-word-2013-visual-basic-applications-image-compression-fix.html

[bibliostat]

I converted the inlineshape to a shape, then selected the shape and cut it to the clipboard. I paste it back as a bitmap which seems to convert it back to an inlineshape and things seem to work.

bDoc.InlineShapes(i).ConvertToShape
bDoc.Shapes.Range(1).Select
Selection.Cut
tbl.Cell(iCurRow, 1).Range.PasteSpecial datatype:=wdPasteBitmap
tbl.Cell(iCurRow, 1).SetWidth ColumnWidth:=InchesToPoints(4.25), rulerstyle:=wdAdjustNone
ClearClipboard

Thanks for the help!

[Dave]

You are welcome. Thank you for posting your outcome. Dave