Hello,
I'm glad that I found this discussion board and I hope that someone could help me.
I've some trouble to get my VBA Script working.
My document is used as a form to get some user input.
It has some tables, each of them has a button, which selects the content of the table, copy the content to the end of the table where the button was pressed.
The table contains contentcontrols, to get the user input.
I have two problems.
1. If I press my copy button, sometimes the table will be copied several times.
2. I would like to remove text, checkbox und date values form the fresh copy at the end of the table.
Here is the code of my Macro:
Code:
Sub copyTableStructure(tblNr As Long, startRow As Integer, endRow As Integer, endColumn As Integer, rowsToInsert As Integer, maxCopies As Integer)
Dim dataRange As Range
Dim lastRow As Range
Dim newDataRange As Range
Set oDoc = ActiveDocument
If (oDoc.ProtectionType <> wdNoProtection) Then
oDoc.Unprotect Password:="xxx"
End If
With ActiveDocument
Set dataRange = .Range(Start:=.Tables(tblNr).Cell(startRow, 1).Range.Start, End:=.Tables(tblNr).Cell(endRow, endColumn).Range.End)
dataRange.Select
Selection.Copy
End With
If (Selection.Rows.Count <= (maxCopies * (endRow - startRow))) Then
With ActiveDocument
Tables(tblNr).Select
Set lastRow = .Range(Start:=.Tables(tblNr).Cell(Selection.Rows.Count, 1).Range.Start, End:=.Tables(tblNr).Cell(Selection.Rows.Count, endColumn).Range.End)
lastRow.Select
Selection.InsertRowsBelow (rowsToInsert)
End With
With ActiveDocument
Tables(tblNr).Select
Set newDataRange = .Range(Start:=.Tables(tblNr).Cell(Selection.Rows.Count - rowsToInsert + 1, 1).Range.Start, End:=.Tables(tblNr).Cell(Selection.Rows.Count, endColumn).Range.End)
newDataRange.Select
Selection.Paste
newDataRange.Select
Dim oFF As FormField
Dim contentCtrl As contentControl
For Each contentCtrl In Selection.Range.contentControls
If contentCtrl.Type = wdContentControlCheckBox Then
contentCtrl.Checked = False
End If
If contentCtrl.Type = wdContentControlText Then
contentCtrl.Range.Text = ""
End If
Next contentCtrl
For Each oFF In Selection.Range.FormFields
oFF.Result = vbNullString
If oFF.Type = wdFieldFormCheckBox Then
oFF.Result = vbFalse
End If
If oFF.Type = wdFieldFormTextInput Then
oFF.TextInput.Clear
End If
Next oFF
Selection.Fields.Update
End With
Else
Dim msg As String
msg = "Not possible to add any other block"
MsgBox (msg)
End If
If (oDoc.ProtectionType = wdNoProtection) Then
oDoc.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="xxx"
End If
End Sub
Private Sub schoolBtn_Click()
Call copyTableStructure(3, 2, 6, 2, 5, 99)
NoAbschlussBtn.Value = False
End Sub
Private Sub WorkBtn_Click()
Call copyTableStructure(5, 2, 8, 2, 7, 99)
NoAbschlussBtn.Value = False
End Sub
Private Sub UniveristyBtn_Click()
Call copyTableStructure(9, 2, 5, 2, 4, 99)
PraktikaBtn.Value = False
End Sub
I hope that someone could help me.
Best regards
H0mebrewer