As the document you have attached has the extension docx it clearly doesn't contain any VBA code.



Depending on where you want to insert your "table template" you may find it better to use a Building Block Gallery Content Control as this will allow the insertion of whatever text etc you want without the use of any code. You will need to use a document template (dotx) for this, not a document.

I have saved the document as a Macro Word, the Drop down lost under impact category is set to ran macro "NSIR" on exit. I kinda recorded a macro of inserting a building block and modified the VBA to insert the table as a building block instead based on the suggestion?? Nothing appears to be happening.

Sub NSIR()
Select Case ActiveDocument.FormFields("ddImpact").Result

Case "Minor Harm"
Selection.Range.ContentControls.Add (wdContentControlBuildingBlockGallery)
Selection.ParentContentControl.BuildingBlockType = wdTypeTables
Application.Templates( _
"C:\Users\wuz1\AppData\Roaming\Microsoft\Docum ent Building Blocks\1033\15\Building Blocks.dotx" _
).BuildingBlockEntries("NSIRDetail").Insert Where:=Selection.Range, _
RichText:=True
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Case "Moderate Harm"
Selection.Range.ContentControls.Add (wdContentControlBuildingBlockGallery)
Selection.ParentContentControl.BuildingBlockType = wdTypeTables
Application.Templates( _
"C:\Users\wuz1\AppData\Roaming\Microsoft\Docum ent Building Blocks\1033\15\Building Blocks.dotx" _
).BuildingBlockEntries("NSIRDetail").Insert Where:=Selection.Range, _
RichText:=True
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1

Case "Severe Harm"
Selection.Range.ContentControls.Add (wdContentControlBuildingBlockGallery)
Selection.ParentContentControl.BuildingBlockType = wdTypeTables
Application.Templates( _
"C:\Users\wuz1\AppData\Roaming\Microsoft\Docum ent Building Blocks\1033\15\Building Blocks.dotx" _
).BuildingBlockEntries("NSIRDetail").Insert Where:=Selection.Range, _
RichText:=True
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1

End Select
End Sub

This is my code for it. Nothing is happening.

Attached Files

TEST.docm (28.8 KB, 4 views)