Creating Tables in Word Programmatically - vb.net

I am generating tables and writing them to word on the fly. I do not know how many tables there will be each time i write the data to word and the problem I am having is the second table is written inside the first cell of my first table. If there was a third table it is put inside the first cell of my second table.
Is there a way to move the cursor out of the table? I have tried creating a new range with each table also but the same thing happens.
I have also tried things like tbl.Range.InsertParagraphAfter()
The closest I came was using the Relocate method, but this only worked for two tables.

I've had this exact same issue and learned that you have to collapse the Range to the end of the table range, then insert a line break, collapse again and then insert your new table.
Here's some code that uses tables and bookmarks - it is meant to show how to use native vs. VSTO host bookmarks (and adding a click handler to the VSTO one) - but you may just need part of the code instead. Look for
With tbRange
.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
.InsertParagraphAfter()
.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd).Select()
End With
below - that's what you'll need to disallow table-within-table nesting.
Sub Assign3TablesToNativeBookmarks()
'this is the native Word bookmark
Dim bm As Word.Bookmark
Dim tb As Word.Table
Dim tbRange As Word.Range
Dim i As Integer
For i = 1 To 3
bm = Me.Bookmarks.Add(Name:="nestedBookmark" & CStr(i), _
Range:=ThisApplication.Selection.Range)
tb = bm.Range.Tables.Add(Range:=bm.Range, NumRows:=2, NumColumns:=2)
With tb
.Style = "Table Grid"
tbRange = .Range
With tbRange
.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
.InsertParagraphAfter()
.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd).Select()
End With
bm = Me.Bookmarks.Add(Name:="nestedbookmark" & CStr(i), Range:=.Range)
End With
Next
Dim bmMain As Word.Bookmark
Dim mainBookmarkRange As Word.Range
Dim mainBookmarkRangeStart As Integer
Dim mainBookmarkRangeEnd As Integer
mainBookmarkRangeStart = Me.Bookmarks(1).Start
mainBookmarkRangeEnd = Me.Bookmarks(Me.Bookmarks.Count).End
mainBookmarkRange = Me.Range(Start:=mainBookmarkRangeStart, End:=mainBookmarkRangeEnd)
bmMain = Me.Bookmarks.Add(Name:="mainBookmark", Range:=mainBookmarkRange)
End Sub
Sub Assign3TablesToHostControlBookmarks()
'Word host control of Bookmark
'bookmarks must be destroyed before resetting the object
'added handler
Dim bm As Microsoft.Office.Tools.Word.Bookmark
'different from the interop one
Dim tb As Word.Table
Dim tbRange As Word.Range
Dim i As Integer
For i = 1 To 3
bm = Me.Controls.AddBookmark(range:=ThisApplication.Selection.Range, _
Name:="nestedBookmark" & CStr(i))
tb = bm.Range.Tables.Add(Range:=bm.Range, NumRows:=2, NumColumns:=2)
With tb
.Style = "Table Grid"
tbRange = .Range
With tbRange
.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
.InsertParagraphAfter()
.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd).Select()
End With
bm.Delete()
'this deletes the bookmark before it can be recreated
bm = Me.Controls.AddBookmark(range:=.Range, Name:="nestedBookmark" & CStr(i))
AddHandler bm.Selected, AddressOf bm_Selected
'handler added
End With
Next
Dim bmMain As Microsoft.Office.Tools.Word.Bookmark
Dim mainBookmarkRange As Word.Range
Dim mainBookmarkRangeStart As Integer
Dim mainBookmarkRangeEnd As Integer
mainBookmarkRangeStart = Me.Bookmarks(1).Start
mainBookmarkRangeEnd = Me.Bookmarks(Me.Bookmarks.Count).End
mainBookmarkRange = Me.Range(Start:=mainBookmarkRangeStart, End:=mainBookmarkRangeEnd)
bmMain = Me.Controls.AddBookmark(range:=mainBookmarkRange, Name:="mainBookmark")
End Sub
Private Sub bm_Selected(ByVal sender As Object, ByVal e As Microsoft.Office.Tools.Word.SelectionEventArgs)
MessageBox.Show("Hey, you have selected bookmark: " & sender.Name & ". " & _
"You did this at " & FormatDateTime(Date.Now(), DateFormat.LongTime))
End Sub

The easiest way to insert tables into word is to generate html tables, and then insert this into the file at the point where your cursor is.
It allows for easy creation of arbitrarily complex nested tables without using most of the ridiculously difficult word interop functions.

Where is it that you want to put each new table? At the end of the document? Start your new table at the end of Document.Content.

Related

Improve 33 checkbox code subs to few? (Checkbox for auto-date in bookmarks)

:)
Im new to VBA!
I have a working code for inserting date where i have a bookmark when using a checkbox (ActiveX). Problem is i have 33 checkboxes (I actually wish for 33x2. one for yes and one for no). So i ended up with 33 Subs and 33 bookmarks. I bet this code can be more efficient braking it down to just a few subs. Annyone has anny idea if it can be done?
The code under is the first of 33 repeating subs where Sub and bookmark name is agi1, agi2 agi3.....
Private Sub agi1_Click()
Dim rngFormat As Range
Set rngFormat = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks("agi1").Range.Start, _
End:=ActiveDocument.Bookmarks("agi1").Range.End)
With rngFormat
.Font.Size = 8
End With
Dim v
Dim BMRange As Range
v = ThisDocument.agi1.Value
'Sjekke om boks er sjekket eller ikke
If v = True Then
'Sett inn dato i bokmerke
Set BMRange = ActiveDocument.Bookmarks("agi1").Range
With Selection.Font
.Size = 9
End With
BMRange.Text = (Format(Date, "dd.mm.yyyy"))
Else
'Erstatte dato med tom tekst hvis boks ikke er sjekket
Set BMRange = ActiveDocument.Bookmarks("agi1").Range
BMRange.Text = " "
End If
'Sett inn bokmerke på nytt
ActiveDocument.Bookmarks.Add "agi1", BMRange
End Sub
You could use event sinking, maybe to.
In an normal module, create a collection and populate it to hold the classes that will control the check box events.
In this have the code, this will need to be run on opening the document, something early in it's life to populate the collection.
Public col As Collection
Public Sub SETUP()
Dim o As InlineShape
Dim c As MSForms.CheckBox
Dim cust As clsCustomCheckBox
Set col = New Collection
For Each o In ActiveDocument.InlineShapes
Set c = o.OLEFormat.Object
Set cust = New clsCustomCheckBox
cust.INIT c
col.Add cust
Next o
End Sub
and then have a class module called clsCustomCheckBox and have it's code as
Private WithEvents c As MSForms.CheckBox
Public Function INIT(cmdIN As MSForms.CheckBox)
Set c = cmdIN
End Function
Private Sub c_Click()
MsgBox "Here you can get the name " & c.Name
End Sub
This will divert each checkbox click to the classes c_click rather than it's own.
So for you
Dim rngFormat As Range
Set rngFormat = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks(c.name).Range.Start, _
End:=ActiveDocument.Bookmarks(c.name).Range.End)
With rngFormat
.Font.Size = 8
End With
.......
ActiveX controls always register their event handlers like so:
Private Sub NameOfTheControl_NameOfTheEvent({args})
If you rename the handler, the control stops working - because the name of the handler must be formed as above, with an underscore separating the name of the control and the name of the handled event.
So if your controls must exist at compile-time, there's no way around it: for 33 controls you need 33 handlers.
That doesn't mean you need that huge procedure repeated 33 times!
Extract a procedure. Select the entire body of that handler, cut it.
Now make a new procedure prototype:
Private Sub HandleCheckBoxClick(ByVal controlName As String)
End Sub
And paste the body in there. Then replace all the places you have a hard-coded "agi1" with a reference to this controlName parameter:
Dim rngFormat As Range
Set rngFormat = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks(controlName).Range.Start, _
End:=ActiveDocument.Bookmarks(controlName).Range.End)
With rngFormat
.Font.Size = 8
End With
'...
The places where you're referring to the control using its programmatic name will be a bit harder:
v = ThisDocument.agi1.Value
You can get the MSForms.CheckBox control through the ThisDocument.InlineShapes collection, but that won't let you find a checkbox by its name, so you need a function that can do it for you:
Private Function FindCheckBoxByName(ByVal controlName As String) As MSForms.CheckBox
Dim sh As InlineShape
For Each sh In ThisDocument.InlineShapes
If TypeOf sh.OLEFormat.Object Is MSForms.CheckBox Then
If sh.OLEFormat.Object.Name = controlName Then
'return the MSForms control:
Set FindControlByName = sh.OLEFormat.Object
End If
End If
Next
And now you can do this:
Dim cb As MSForms.ChecBox
Set cb = FindCheckBoxByName(controlName)
If cb Is Nothing Then
MsgBox "No ActiveX CheckBox control named '" & controlName & "' was found in ThisDocument."
Exit Sub
End If
v = cb.Value
Once all references to the ActiveX control are parameterized, your 33 handlers can now look like this:
Private Sub agi1_Click()
HandleCheckBoxClick "agi1"
End Sub
Private Sub agi2_Click()
HandleCheckBoxClick "agi2"
End Sub
'...
Private Sub agi33_Click()
HandleCheckBoxClick "agi33"
End Sub
Alternatively, you could have the checkboxes created at run-time, and then have their Click event handled in a dedicated class module, but that's a little bit more involved ;-)

Is it possible to use a Pivot Table in a userform?

Is it possible to insert a pivot table into a userform in VBA? I saw this other question about it, but I'm able to find the Microsoft Office PivotTable control in the right-click menu. I did find the Tree View, but that isn't quite the same thing I don't think.
UPDATE
I'm creating an Inventory workbook for use in my office. I'll allow others to use it to see what we have and to request items that we have in inventory. I'm going to use the Userform for this. I have a dashboard for myself in the workbook that has several pivot tables already. There are 2 that I'd like to use in the Userform.
The regular users won't have access to edit the workbook, or even to change which sheet is showing, they only need access to view the 2 pivots that I want to add to this Userform.
So, the end result is going to be that the end user will have a pivot table that will allow them to see what we have in inventory and request it or send an email that will create a PO to order it.
I've been using Excel for a very long time and I've never heard of anyone need this combination (UserForm+PT), but anyway, I did a quick Google search and came up with this.
Option Explicit
Dim cnnConnection As Object
Private Sub Form_Load()
Dim strProvider As String
Dim view As PivotView
Dim fsets As PivotFieldSets
Dim c As Object
Dim newtotal As PivotTotal
strProvider = "Microsoft.Jet.OLEDB.4.0"
' Create an ADO object
Set cnnConnection = CreateObject("ADODB.Connection")
' Set the provider and open the connection to the database
cnnConnection.Provider = strProvider
cnnConnection.Open "C:\pivottest.mdb"
' Set the pivot table's connection string to the cnnConnection's connection string
PivotTable1.ConnectionString = cnnConnection.ConnectionString
' SQL statement to get everything from table1
PivotTable1.CommandText = "Select * from table1"
' Get variables from the pivot table
Set view = PivotTable1.ActiveView
Set fsets = PivotTable1.ActiveView.FieldSets
Set c = PivotTable1.Constants
' Add Category to the Row axis and Item to the Column axis
view.RowAxis.InsertFieldSet fsets("Category")
view.ColumnAxis.InsertFieldSet fsets("Item")
' Add a new total - Sum of Price
Set newtotal = view.AddTotal("Sum of Price", view.FieldSets("Price").Fields(0), c.plFunctionSum)
view.DataAxis.InsertTotal newtotal
view.DataAxis.InsertFieldSet view.FieldSets("Price")
' Set some visual properties
PivotTable1.DisplayExpandIndicator = False
PivotTable1.DisplayFieldList = False
PivotTable1.AllowDetails = False
End Sub
Private Sub Form_Terminate()
' Remove reference to the ADO object
Set cnnConnection = Nothing
End Sub
Private Sub PivotTable1_DblClick()
Dim sel As Object
Dim pivotagg As PivotAggregate
Dim sTotal As String
Dim sColName As String
Dim sRowName As String
Dim sMsg As String
' Get the selection object you double-clicked on
Set sel = PivotTable1.Selection
' If it is a aggregate, you can find information about it
If TypeName(sel) = "PivotAggregates" Then
' Select the first item
Set pivotagg = sel.Item(0)
' Display the value
MsgBox "The cell you double-clicked has a value of '" & pivotagg.Value & "'.", vbInformation, "Value of Cell"
' Get variables from the cell
sTotal = pivotagg.Total.Caption
sColName = pivotagg.Cell.ColumnMember.Caption
sRowName = pivotagg.Cell.RowMember.Caption
' Display the row and column name
sMsg = "The value is " & sTotal & " by " & sRowName & " by " & sColName
MsgBox sMsg, vbInformation, "Value Info"
End If
End Sub
See if you can adapt that concept to your specific setup.
https://support.microsoft.com/en-us/help/235542/how-to-use-the-pivottable-office-web-component-with-vb

How to cross reference macro generated bookmark

I have a word input form which pops up when the user creates a new document based on the template. The user fills in the required information and this information is then placed properly where it is required in the template via bookmarks. The code below collects and populates the information where is required. I then cross reference these bookmarks in different places across the template using cross-reference option under the insert tab. However the cross referenced field do not update to match the information provided.
Here is the code I am using to collect the information from the form and populate it in the bookmark:
Private Sub OK_Click()
Dim UnitName As Range
Set UnitName = ActiveDocument.Bookmarks("UnitName").Range
UnitName.Text = Me.AgisanangUnitNameInput.Value
Dim OrderNo As Range
Set OrderNo = ActiveDocument.Bookmarks("OrderNo").Range
OrderNo.Text = Me.OrderNoInput.Value
Dim ItemNo As Range
Set ItemNo = ActiveDocument.Bookmarks("ItemNo").Range
ItemNo.Text = Me.ItemNoInput.Value
Dim Reference As Range
Set Reference = ActiveDocument.Bookmarks("Reference").Range
Reference.Text = Me.ReferenceInput.Value
Dim DocumentNo As Range
Set DocumentNo = ActiveDocument.Bookmarks("DocumentNo").Range
DocumentNo.Text = Me.DocumentNoInput.Value
Dim RevisionNo As Range
Set RevisionNo = ActiveDocument.Bookmarks("RevisionNo").Range
RevisionNo.Text = Me.RevisionNoInput.Value
Dim ProjectName As Range
Set ProjectName = ActiveDocument.Bookmarks("ProjectName").Range
ProjectName.Text = Me.ProjectNameInput.Value
Dim PreparedFor As Range
Set PreparedFor = ActiveDocument.Bookmarks("PreparedFor").Range
PreparedFor.Text = Me.PreparedForInput.Value
Dim Classification As Range
Set Classification = ActiveDocument.Bookmarks("Classification").Range
Classification.Text = Me.ClassificationInput.Value
Dim DocumentType As Range
Set DocumentType = ActiveDocument.Bookmarks("DocumentType").Range
DocumentType.Text = Me.DocumentTypeInput.Value
Dim TitleOfReport As Range
Set TitleOfReport = ActiveDocument.Bookmarks("TitleOfReport").Range
TitleOfReport.Text = Me.TitleOfReportInput.Value
Me.Repaint
ReportInputForm.Hide
End Sub
Try something like this.
Dim Rng As Range
For Each Rng In ActiveDocument.StoryRanges
With Rng
If .Fields.Count Then .Fields.Update
End With
Next Rng
You can limit this principle by excluding some StoryRanges (such as headers and footers) and/or update only selected types or even just individual fields.
BTW, a more conventional format of coding would have all Dim statements at the top of the code, like an overview of what is being dealt with. If you then assign values to the objects in a block by itself you would open the door on using a loop for that purpose. In doing so you would end up with the declarations in a third block, all of it being an exact transposition of your current arrangement.
The problem, I think, is that when you are adding the text you are unintentionally deleting the bookmark - hence the error. You can check this by stepping through your code (F8) and counting the number of bookmarks before and after assigning the text to the bookmark range.
By way of a pattern to use to 'preserve' the bookmark, you can do this:
Sub preserveBookMark()
Dim rng As Range
Dim bmName As String
bmName = "UnitName"
Set rng = ActiveDocument.Bookmarks(bmName).Range
rng.Text = Me.AgisanangUnitNameInput.Value ' deletes the bookmark
rng.Bookmarks.Add ("bmName") ' re-add deleted bookmark
activedocument.Fields.Update
End Sub

better method for accenting every word in Word document?

I am new to programming, but I am trying to adapt an existing script as a MS Word 2010/2013 addin to add correct stress accentuation to every Latin word in an open document.
The script "DoAccentuate" returns an accented word for any unaccented Latin word I send it as a string. I just need help doing a better job of looping through all the words, and then stopping the loop when the last word is reached. My current method is a bit goofy...I insert a nonesense word at the end of the document and then loop until it gets selected and accented.
Perhaps there's a better or more efficient way to go about the whole thing.
Public Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
Dim document As Word.Document
document = Globals.ThisAddIn.Application.ActiveDocument
Dim mySelection = document.Application.Selection
'make sure cursor is at start of document
document.Application.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdStory)
'insert fake word at end to stop the loop
Dim range As Word.Range
range = document.Range()
range.InsertAfter(" documentendatoris")
Do
'use MS Word's wildcard to select the first individual word as trimmed string
mySelection.Find.Text = "<*>"
mySelection.Find.MatchWildcards = True
mySelection.Find.Execute()
'replace the selected word that has been found with its accented counterpart
mySelection.Text = Accentuate.Accentuate.DoAccentuate(mySelection.Text)
Loop Until mySelection.Text = "documentendatóris"
End Sub
Well, I don't realy know if its more efficient way but you could use document.Content and range.Words collection to check all words in main story range
document = Globals.ThisAddIn.Application.ActiveDocument
Dim range As Word.Range
range = document.Content
Dim current As Integer
current = 0
Dim words As Word.Words
words = range.Words
Dim word As Word.Range
Do
current = current + 1
If current < words.Count Then
word = words(current)
If word.Text.EndsWith(" ") Then
word.Text = word.Text.Trim() + "'s "
'replace the selected word that has been found with its accented counterpart
'mySelection.Text = Accentuate.Accentuate.DoAccentuate(mySelection.Text)
Else
word.Text = word.Text.Trim() + "'s"
End If
End If
Loop Until current = words.Count

Detecting Event on ComboBoxes Added at Runtime on Excel

I have a problem with my VBA script in Excel. What I do is basically creating buttons that when pressed will create a set of two extra comboboxes in one of the sheet. This button can be pressed continuously to add more comboboxes.
These newly created comboboxes will behave like this:
Created 2 Combobox
Combobox1 will load some list in Control sheet
Whenever an item in Combobox1 is selected, Combobox2 will load list of items to be added to Combobox2
The code for adding the button is like this
Sub Add_Criteria()
Dim controlNum As Integer
Dim name1 As String
Dim name2 As String
Dim oOle1 As OLEObject
Dim oOle2 As OLEObject
Dim uniqueString As String
Dim cb1 As Object
controlNum = Sheets("Controls").Range("A16").Value
'adding Control
Set oOle1 = Sheets("System").OLEObjects _
.Add(ClassType:="Forms.ComboBox.1", Left:=10, _
Top:=75 + (controlNum * 20), Width:=100, Height:=18)
Set oOle2 = Sheets("System").OLEObjects _
.Add(ClassType:="Forms.ComboBox.1", Left:=120, _
Top:=75 + (controlNum * 20), Width:=100, Height:=18)
'adding properties
oOle1.Name = "Criteria" & controlNum * 2 - 1
oOle2.Name = "Criteria" & controlNum * 2
'adding control var
Sheets("Controls").Range("A16").Value = controlNum + 1
With oOle1.Object
.List = Sheets("Controls").Range("A5:A13").Value
End With
End Sub
The question is, I cannot detect events on it. I need to change the value shown on the second combobox created when value in combobox1 changed. I tried to use below reference and I still can't. Can anyone guide me on how to do this
Reference (Been on this Problem for days):
http://www.dbforums.com/microsoft-excel/1641165-detecting-click-event-dynamically-created-controls.html (This is for userform, I don't know why I can't replicate this in Sheet)
You can add Events programmatically. The code below adds an event for each combobox
This reference from Pearson Programming The VBA Editor may also be useful.
Sub Add_Criteria()
Dim controlNum As Integer
Dim name1 As String
Dim name2 As String
Dim oOle1 As OLEObject
Dim oOle2 As OLEObject
Dim uniqueString As String
Dim cb1 As Object
Dim strCode As String
Dim vbProj As Object
Dim vbCodeMod As Object
Set vbProj = ActiveWorkbook.VBProject
Set vbCodeMod = vbProj.vbcomponents(ActiveSheet.CodeName).codemodule
controlNum = Sheets("Controls").Range("A16").Value
'adding Control
Set oOle1 = Sheets("System").OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:=10, Top:=75 + (controlNum * 20), Width:=100, Height:=18)
Set oOle2 = Sheets("System").OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:=120, Top:=75 + (controlNum * 20), Width:=100, Height:=18)
vbCodeMod.AddFromString AddEvent(oOle1.Name)
vbCodeMod.AddFromString AddEvent(oOle2.Name)
'adding properties
oOle1.Name = "Criteria" & controlNum * 2 - 1
oOle2.Name = "Criteria" & controlNum * 2
'adding control var
Sheets("Controls").Range("A16").Value = controlNum + 1
With oOle1.Object
.List = Sheets("Controls").Range("A5:A13").Value
End With
End Sub
Function AddEvent(strIn As String) As String
AddEvent = "Private Sub " & strIn & "_Click()" & Chr(10) & _
"MsgBox ""Event Added""" & Chr(10) & _
"End Sub"
End Function
Open a fresh Workbook and rename sheets 1 and 2 "System" and "Controls", respectively.
Open the VBA Editor and paste YOUR code code above into a general module.
Run your code.
Return to Excel. (Alt+F11)
Right-click on the System sheet tab and select View Code.
Paste the following in the module:
Sub FillCombo()
With Sheets("System").Criteria299 'Change the name of the control as needed.
.AddItem 1
.AddItem 2
End With
End Sub
Private Sub Criteria299_Change()
'Example of triggering the Change Event using Select Case
With Sheets("System")
Select Case .Criteria299.Value
Case 1
.Criteria300 = "Dog" 'Change the name of the control as needed.
Case 2
.Criteria300 = "Cat"
End Select
End With
End Sub
Look at Project Explorer and you'll see that the code is in the System worksheet module, not in a general module.
Any event procedures for controls added to a worksheet must be in stored in that worksheet's module.
The FillCombo sub can be put in a general module as long as you refer to the sheet name that has the control as shown.