VBA code that will delete all macros in the Active Document on Save

[Doctorjones_md]

I'm trying to create the following -- the final step involves removing ALL
macros from the Active Document when saved

I have a Word.dot that has a variety of BookMarks in it -- PLUS a series of
forms with allow the user to:
a. Fill-In Text Boxes which populated bookmarked areas in the Header and
Body of the Active Document
b. Click Checkboxes and Radio Buttons to add Paragraphs of Text in the body
of the Active Document
c. Click Checkboxes and Radio Buttons to add data to the Active Document
(comprised of 5 columns of data from a Word Table in a separate Word
Document)

The problem I have here is that if I select more than 1 checkbox or
radio-button item, the (5) columns of data from the 2nd selection gets
nested in Cell (1) of the Row that was added to the Active Document in the
1st selection. Is there a way that I can force the code in subsequent
selections to insert a completely NEW row into the table (not nest all 5
cells of NEW data into Row(1) Cell(1) )?

The last thing that needs to occur is for all Macros to be removed from the
Active Document when saving it as a Word.doc -- how can I do this?

Much thanks in advance!

Shane

 

[Jezebel]

No way to answer your first question on the information you've provided.

And the second question doesn't make sense. The code should be in the
template; in which case there's nothing to remove from the document. And if
it IS in the document, you're stuffed anyway: your code can't remove itself.

 

[Doctorjones_md]

Jezebel,

Thanks for the reply -- if I have 1 document (Doc1) having a Table with 100
Rows and 5 Columns, how would I insert a single Row (all 5 Cells) from this
table into another Table in a second document (that we'll call Doc2)?

I tried using this code --
ActiveDocument.Bookmarks("bookmarkname").Range.Cells(1).Range -- but
couldn't get it to work -- I don't understand the following comment (to
refer to the first cell in the bookmark, then increment the number for the
remaining cells) how would I increment the number>

Since I couldn't figure out how to select a single Row of 5 Cells, I made a
separate document for each line item (Row) and used the following code:

Private Sub cbxProducts_Click()
If Me.cbxLinen.Enabled = True Then

ActiveDocument.Bookmarks("Linen").Range.InsertAfter Linen
sFilePath = ActiveDocument.AttachedTemplate.Path &
"\products\linen\506E.doc"
Selection.InsertFile sFilePath, , False, False

'Selection.InsertFile sFilePath, Cells(1), False, False

Me.cmdOK.Enabled = True

End If
End Sub

This codes inserts any (1) item selected (by either a checkbox or
radio-buttton) without any problem, but if I make more than (1) selection,
then the 2nd selection gets nested in Row(1) Cell(1) of the first table that
was inserted into the Active Document.

This may help -- I inserted bookmarks in Doc2 called "Linen", "Pillows",
"Mattresses" -- I didn't create a Table in Doc2, I simply inserted a
bookmark (should I have used --
ActiveDocument.Bookmarks("BookmarkName").Range.Text="Text" -- INSTEAD of
-- ActiveDocument.Bookmarks("BookmarkName").Range.InsertAfter"Text" ?


Shane

=====================================================

 

[Doctorjones_md]

Jezebel,

Thanks for the reply -- if I have 1 document (Doc1) having a Table with
100 Rows and 5 Columns, how would I insert a single Row (all 5 Cells) from
this table into another Table in a second document (that we'll call Doc2)?

I tried using this code --
ActiveDocument.Bookmarks("bookmarkname").Range.Cells(1).Range -- but
couldn't get it to work -- I don't understand the following comment (to
refer to the first cell in the bookmark, then increment the number for the
remaining cells) how would I increment the number>

Since I couldn't figure out how to select a single Row of 5 Cells, I made
a separate document for each line item (Row) and used the following code:

Private Sub cbxProducts_Click()
If Me.cbxLinen.Enabled = True Then

ActiveDocument.Bookmarks("Linen").Range.InsertAfter Linen
sFilePath = ActiveDocument.AttachedTemplate.Path &
"\products\linen\506E.doc"
Selection.InsertFile sFilePath, , False, False

'Selection.InsertFile sFilePath, Cells(1), False, False

Me.cmdOK.Enabled = True

End If
End Sub

This codes inserts any (1) item selected (by either a checkbox or
radio-buttton) without any problem, but if I make more than (1) selection,
then the 2nd selection gets nested in Row(1) Cell(1) of the first table
that was inserted into the Active Document.

This may help -- I inserted bookmarks in Doc2 called "Linen", "Pillows",
"Mattresses" -- I didn't create a Table in Doc2, I simply inserted a
bookmark (should I have used --
ActiveDocument.Bookmarks("BookmarkName").Range.Text="Text" -- INSTEAD of
-- ActiveDocument.Bookmarks("BookmarkName").Range.InsertAfter"Text" ?


Shane

=====================================================

 

[Doctorjones_md]

Jezebel,

Do you see any value in this snipit of code (in getting me where I need to
go):
Select a range of cells within a table
If Selection.Information(wdWithInTable) = False Then Exit Sub
Selection.SetRange _
Start:=Selection.Tables(1).Cell(2, 2).Range.Start, _
End:=Selection.Tables(1).Cell(3, 3).Range.End



Thanks in Advance.

Shane

 

[Jezebel]

First: you make life hard for yourself by using the Selection object. It's
always better to use Range objects.

To insert row 10 from table 6 in Doc1 to follow row 3 in table 2 in Doc 2 --

Dim pTable1 As Table
Dim pTable2 As Table
Dim pIndex As Long
Dim pRange As Word.Range

Set pTable1 = Documents("Doc1").Tables(6)
Set pTable2 = Documents("Doc2").Tables(2)

pTable2.Rows.Add BeforeRow:=t2.Rows(4)
For pIndex = 1 To pTable1.Columns.Count
Set pRange = pTable1.Cell(10, pIndex).Range
pRange.End = pRange.End - 1
pRange.Copy
pTable2.Cell(4, pIndex).Range.Paste
Next

 

[Doctorjones_md]

OK,

So now I have the following on the frmProducts Form

Private Sub cbxLinen_Click()
Dim pTable1 As Table
Dim pTable2 As Table
Dim pIndex As Long
Dim pRange As Word.Range

Set pTable1 = Documents("Linen").Tables(1) **** I get an error 4160 -
Bad File Name -- even if I enter the full file path of
("E:\\Products\Linen.doc")
Set pTable2 = Documents("Products").Tables(11)

If Me.cbxLinen.Value = True Then

pTable11.Rows.Add BeforeRow:=t2.Rows(3)
For pIndex = 1 To pTable1.Columns.Count
Set pRange = pTable1.Cell(1, pIndex).Range
pRange.End = pRange.End - 1
pRange.Copy
pTable2.Cell(3, pIndex).Range.Paste

End If

Next

End Sub

What am I doing wrong?



End Sub

 

[Doctorjones_md]

Jezebel,

What I don't understand in your suggestion is -- are we still using
Bookmarks?

 

[Jezebel]

1. Set pTable1 = Documents("Linen").Tables(1) **** I get an error 4160

In the Immediate window, have a look at the Documents() collection, eg type

? Documents(1).Name (2, 3, etc) -- you can see how the documents are
referred to. Or, if the documents are opened as part of your form code,
retain a reference:

Set doc = Documents.Open("C:\...")

then use that --

Set pTable1 = doc.Tables(n) ..

If one of the documents is known to be the activedocument when the code is
run, you can use that as your reference --

Set pTable1 = ActiveDocument.Tables(n)


2. I didn't understand what you were using the boomarks for in the first
place. If the bookmark identifies the tables that you are copying from and
to, then of course, go on using them. Eg, if you're copying row 5 from the
table identified by 'MyBookmark' then you'd use something like

Set pTable1 = doc.Bookmarks("MyBookmark").Range.Tables(1)


3. This line is wrong --

pTable11.Rows.Add BeforeRow:=t2.Rows(3)

t2 should be pTable2 (my mistake, sorry)

and pTable11 should be pTable1 (your mistake)

 

[doctorjones_md]

Jezebel,

Thank you for all your help. I've been able in incorporate your code into
my project, but I seem to be getting the following error message when I run
it:
"Run-time error 4605" This method or property is not available because no
text is selected

When I get the error message, if I choose debug, the following line is
highlighted:

pRange.Copy

If I Reset press the Reset button in the menu bar of VBE, then the data from
the seleted Row is inserted into Document1

I get the error message when I run routine #1 below, but not when I run
routine #2 (see below)

Could you please tell me how I can resolve this issue? Here is the code
I'm using:

#1 'Code for frmProducts:
Option Explicit

Dim pTable1 As Table
Dim pTable2 As Table
Dim pIndex As Long
Dim pRange As Word.Range
Dim ExportDoc As Word.Document '**** NOTE -- I set these dimensions
outside for the Sub (as in your example) so I could use it for several
subs/options on the form

Private Sub cbxLinen_Click()

Set ExportDoc = Documents.Open("E:\Products\Linen.doc") '*** This Opens
the file Linen.doc as ExportDoc Projects -- How do I close write the code to
close ExportDoc after the data has been inserted into Document1?****

Set pTable1 = ExportDoc.Tables(1)
Set pTable2 = Documents("Document1").Tables(12) '**** I want the data
from ExportDoc.Tables(1) to be inserted into Table 12 of Document1

If Me.cbxLinen.Value = True Then

Me.cbxNotIncluded.Value = False '***** This is the default value of
frmProducts

pTable1.Rows.Add BeforeRow:=pTable2.Rows(3) 'Adds a NEW row in the
destination table -- active document

For pIndex = 1 To pTable1.Columns.Count
Set pRange = pTable1.Cell(7, pIndex).Range 'The row in the Table you
want to import
pRange.End = pRange.End - 1
pRange.Copy '**** This is the line that's highlighted during debug
pTable2.Cell(3, pIndex).Range.Paste

Next

Me.cmdOK.Enabled = True

End If

Set ExportDoc = Nothing '**** I thought this might close ExportDoc, but it
does nothing -- any thoughts?

End Sub

==============================================
BUT -- everything works fine on this form (with identical code) -- EXCEPT
that the file ExportDoc doesn't close after copying the Rows to Document1
==============================================
#2 'Code for frmServices:
Option Explicit

Dim pTable1 As Table
Dim pTable2 As Table
Dim pIndex As Long
Dim pRange As Word.Range
Dim ExportDoc As Word.Document

Private Sub cbxDelivery_Click()

Set ExportDoc = Documents.Open("H:\Services\Delivery.doc")
Set pTable1 = ExportDoc.Tables(1)
Set pTable2 = Documents("Document1").Tables(8) 'Sets Table 8 as the
insertion point

If Me.cbxMS_IDE.Value = True Then

pTable1.Rows.Add BeforeRow:=pTable2.Rows(3) 'Sets the insertion
point before Row 3
For pIndex = 1 To pTable1.Columns.Count
Set pRange = pTable1.Cell(2, pIndex).Range 'Selects Row 2 in
ExportDoc
pRange.End = pRange.End - 1
pRange.Copy
pTable2.Cell(3, pIndex).Range.Paste 'Pastes data in Row 3 of Table 8
in Document1
Next

Me.cmdOK.Enabled = True

End If

Set ExportDoc = Nothing

End Sub

Much Thanks in Advance

Shane
==========================================================================