Is there an example of a macro that converts each ActiveX text box in a Word document to a table cell (1 x 1). Text formatting can be ignored.
I have this example for Excel, but do not know which Word objects and methods to use.
I want to use ActiveX text boxes to restrict the size of the text content, which is not directly possible in Word table cells. Also I do not want to insert text form fields into the Word table cells instead of using text boxes, because of subsequent processing of the tables.
Without an example of conversion, which would be more elegant, I have written a workaround that copies the text box content to a 1x1 table. Note that ALL inline shapes are subsequently deleted, not just text boxes.
Sub Copy_textbox_to_new_table()
'Loops through ActiveX text boxes and copies content
'Adds table at bookmark named "bm1", "bm2", ...
'Pastes text from text box into table
'NB all text boxes to be copied must be renamed "TB1", "TB2", ...
Dim txtbText(1 To 5)
Dim txtb As InlineShape
Dim i As Long 'counter
Dim tbl(1 To 5)
Dim tblPlace As Range
On Error Resume Next
For i = 1 To 5 '<-text box names must be modified to TB1 ... TBn and value of n is To value here
For Each txtb In ActiveDocument.InlineShapes
If Not txtb.OLEFormat Is Nothing And _
txtb.OLEFormat.ClassType = "Forms.TextBox.1" And _
txtb.OLEFormat.Object.Name = "TB" & i Then
txtbText(i) = txtb.OLEFormat.Object.Text
Set tblPlace = ActiveDocument.Range.Bookmarks("bm" & i).Range
Set tbl(i) = ActiveDocument.Tables.Add(Range:=tblPlace, NumRows:=1, NumColumns:=1)
tbl(i).Cell(1, 1).Select
Selection.Text = txtbText(i)
End If
Next
Next
'Delete all inline shapes
For i = ActiveDocument.InlineShapes.Count To 1 Step -1
ActiveDocument.InlineShapes(i).Select
Selection.Delete
Next i
End Sub
Related
I am struggling quite a bit with ContentControl(s) in my Word VBA project.
There are a number of content control text fields which all have the same name (they have the same name because at the beginning the total number of required fields is not known, so I copy and paste the fields as many times as required). Now I want to loop through the content control fields and change the name of the fields based on the index of the individual items (e.g. first field in the document = "One", second field in the document = "two" and so on).
However, as mentioned in other threads, the index of the content control element does not correspond to its position in the document (I do not know, what it corresponds to).
Thus, instead of getting the fields in order, I get e.g. "four" --> "one" --> "three" --> "two" (or any other possible combination).
The content of the fields is coming from UserForm TextBoxes. The text boxes are named Text_Box_1 to Text_Box_4:
Private Sub Test() 'Note: The actual code is more complex, this is just to demonstrate my problem.
Dim i As Integer
UserForm1.TextBox1 = "one"
UserForm1.TextBox2 = "two"
UserForm1.TextBox3 = "three"
UserForm1.TextBox4 = "four"
For i = 1 To 4 - 1 'Since there are four text boxes in the UserForm in this example, the text snippet containing the text field gets copied and pasted three times; Note: Here the number of textboxes is pre-determined and fixed, in the actual project, it is variable.
ActiveDocument.Bookmarks(Index:="Copy").Range.Copy '
ActiveDocument.Bookmarks(Index:="Paste").Range.Paste
Next i
For i = 1 To 4 'This code is supposed to loop through the four content control text fields and insert text from the corresponding UserForm text box. However, content control text field 1, unfortunately does no correspond to UserForm.TextBox1 for some reason.
ActiveDocument.SelectContentControlsByTitle("Number").Item(i).Range.Text = UserForm1.Controls("TextBox" & i)
Next i
End Sub
Before running the code
After runnning the code
Is there any way to name to content control fields in the right order?
If not, what would be an alternative method to achieve my goals.
I think legacy text fields are not an option, since the document has to be protected; I have not looked into ActiveX text fields too much; Text boxes (shapes) might be another option, but they might have their own drawbacks.
It is really frustrating that the content control fields are behaving so weirdly and that something seemingly very simple and straight-forward can be so complicated (at least for me).
edit: Fixed a typo in the title.
Rather than use copy and paste I would insert the required text and content controls in my routine, something like this.
Private Sub Test()
Dim i As Integer
UserForm1.TextBox1 = "one"
UserForm1.TextBox2 = "two"
UserForm1.TextBox3 = "three"
UserForm1.TextBox4 = "four"
Dim cc As ContentControl
Dim rng As Range
Dim ccLocation As Range
For i = 4 To 1 Step -1 'Insert in reverse order to ensure that they are correct in the document
Set rng = ActiveDocument.Bookmarks("Paste").Range
rng.InsertAfter Text:="Number: "
rng.Collapse wdCollapseEnd
Set ccLocation = rng.Duplicate
rng.InsertAfter vbCr & "----------------------------------------" & vbCr
Set cc = ccLocation.ContentControls.Add(wdContentControlText)
cc.Range.Text = UserForm1.Controls("TextBox" & i).Text
cc.Title = "Number" & i
Next i
End Sub
If you cannot delete the existing content and must work with what you have then you could use the following:
Private Sub Test()
Dim i As Integer
UserForm1.TextBox1 = "one"
UserForm1.TextBox2 = "two"
UserForm1.TextBox3 = "three"
UserForm1.TextBox4 = "four"
ActiveDocument.SelectContentControlsByTitle("Number").Item(i).Range.Text = UserForm1.Controls("TextBox1").Text
Dim cc As ContentControl
Dim rng As Range
Dim ccLocation As Range
For i = 4 To 2 Step -1 'Insert in reverse order to ensure that they are correct in the document
Set rng = ActiveDocument.Bookmarks("Paste").Range
rng.InsertAfter Text:="Number: "
rng.Collapse wdCollapseEnd
Set ccLocation = rng.Duplicate
rng.InsertAfter vbCr & "----------------------------------------" & vbCr
Set cc = ccLocation.ContentControls.Add(wdContentControlText)
cc.Range.Text = UserForm1.Controls("TextBox" & i).Text
cc.Title = "Number" & i
Next i
End Sub
I've managed to create a form where the user can expand the fields of a pivot table and, once they've completely expanded a field/branch, a button will appear in column E and that pivot field data is concatenated in column J (there are some hidden columns).
What I want is for the user to click an auto-generating button in column E which exports the corresponding data in column J to a list, somewhere on the workbook.
My code below automatically generates the buttons for fully expanded fields, but I have no idea how to write the code to link each button to the corresponding cell in column J - this is probably not very difficult but any help would be appreciated.
Sub buttonGenerator()
Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.Buttons.Delete
Dim t As Range
Dim size As Integer
size = ActiveSheet.PivotTables("Pivottable1").TableRange2.Rows.Count
For i = 2 To size Step 1
If Not IsEmpty(ActiveSheet.Range(Cells(i, 4), Cells(i, 4))) Then
Set t = ActiveSheet.Range(Cells(i, 5), Cells(i, 5))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "btnS"
.Caption = "Add to summary" '& i
.Name = "Btn" & i
End With
End If
Next i
Application.ScreenUpdating = False
End Sub
Sub buttonAppCaller()
MsgBox Application.Caller
End Sub
So here is my code .. it is throwing Runtime error 1004 "Unable to get the Buttons property of the worksheet class". Not sure what I've done wrong but I need to get the data from the cell next to the button to copy over to the bottom of a list in sheet 2 when that particular button is clicked. Please help!
Sub btnS()
Dim dest As Range
Dim origin As Range
origin = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Offset(0, 1) 'input data from cell next to button click
dest = Worksheets("Form Output").Range("A1") 'output data to list in sheet 2 - "Form output"
Set dest = origin
End Sub
Don't use Integer for row counts as you did for size. Excel has more rows than Integer can handle. It is recommended always to use Long instead of Integer in VBA there is no benefit in Integer at all.
The procedure every button invokes is called btnS as you defined in .OnAction = "btnS". Therefore you need a Sub with that name in a Module.
You can use Buttons(Application.Caller).TopLeftCell to get the cell under a button and from that cell you can determine the row or column.
Public Sub btnS() 'sub name must match `.OnAction` name
MsgBox ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
End Sub
Instead of using ActiveSheet I recommend to use a specific worksheet like Worksheets("your-sheet-name") if you plan to use it on a specific sheet only. ActiveSheet can easily change and should be avoided where possible.
I am extremely new to VBA and am trying to create a spreadsheet that uses a checkbox userform to populate a table in a spreadsheet. I have been able to get the table to populate, but if a box is accidentally checked and is unchecked, the table remains populated. How do I get the table to go back to being blank after a box is unchecked and what is an efficient way to code the 33 checkboxes to populate the 33 spaces in the spreadsheet. Please see the images attached to aid in my description.
Thanks,
Userform Image
Spreadsheet Image
Setting the CheckBox ControlSource Property to a range address will link it to the range. If the range isn't qualified A1 the Checkbox will link to the Worksheet that is the ActiveSheet when the Userform Opens. To qualify the address add the Range's parent Worksheet's Name in single quotes followed by a exclamation mark and finally the ranges relative address 'Check List'!A1.
Initially, the Checkbox will be grayed out indicating that the linked cell is empty. When you check and uncheck it the linkedcell value will toggle between True and False.
Demo Userform Code
Private Sub UserForm_Initialize()
Dim Left As Single, Top As Single
Dim cell As Range, row As Range, check As MSForms.CheckBox
Top = 25
Left = 25
With Worksheets("Check List")
For Each row In .Range("A2:K4").Rows
For Each cell In row.Cells
Set check = Me.Controls.Add("Forms.CheckBox.1")
With check
.ControlSource = "'" & cell.Parent.Name & "'!" & cell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
.Left = Left
.Top = Top
Left = Left + 12
End With
Next
Left = 25
Top = Top + check.Height + 2
Next
End With
End Sub
Following issue:
I declare tbl as Table in VBA. I want to show some tables in PowerPoint.
If the text of the cells are too long, the cells get big and they go beyond the slide limits. I want to avoid that. I just want to resize the text, that means, I just want that the text gets smaller, in order to fit within the cell. That means, cell-table size should not be changed!
How would you do that? I've tried:
ppPres.Slides(NumSlide).Shapes(NumShape).Table.Columns(col).Cells(1).Shape.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
without success. Could you please tell me what's wrong and how would you proceed?
The error message is as follows:
Run-Time error '2147024809 (80070057)'
The specified value is out of range.
This is one of the oddities of the PowerPoint OM. The Shape object has all of the properties listed by IntelliSense, including the AutoSize property, yet when referenced within a table, some properties are not available. AutoSize is one of them. For example, if you place your cursor within a cell and open the the Format Shape pane in PowerPoint, you can see that the 3 AutoSize radio buttons are greyed out as well as the Wrap text in shape checkbox:
In the above example, which was created by adding the table via the PowerPoint UI rather than programmatically, I then copied the text from cell 2,1 to 1,2 with this code and the cell didn't change width but does change height, potentially forcing the table off of the bottom of a slide:
ActiveWindow.Selection.ShapeRange(1).Table.Cell(1,2).Shape.TextFrame.TextRange.Text=_
ActiveWindow.Selection.ShapeRange(1).Table.Cell(2,1).Shape.TextFrame.TextRange.Text
If it's this that you're trying to control, you'll need to do it manually in code via examining the table cell and/or table height after inserting your text and reducing the font size iteratively and rechecking each reduction level to see if the table is still out of the slide area.
This code does that for you:
Option Explicit
' =======================================================================
' PowerPoint Subroutine to iteratively reduce the font size of text
' in a table until the table does not flow off the bottom of the slide.
' Written By : Jamie Garroch of YOUpresent Ltd. http://youpresent.co.uk/
' Date : 05DEC2016
' Inputs : Table object e.g. ActiveWindow.Selection.ShapeRange(1).Table
' Outputs : None
' Dependencies : None
' =======================================================================
Sub FitTextToTable(oTable As Table)
Dim lRow As Long, lCol As Long
Dim sFontSize As Single
Const MinFontSize = 8
With oTable
Do While .Parent.Top + .Parent.Height > ActivePresentation.PageSetup.SlideHeight
For lRow = 1 To .Rows.Count
For lCol = 1 To .Columns.Count
With .Cell(lRow, lCol).Shape
sFontSize = .TextFrame.TextRange.Font.Size
If sFontSize > MinFontSize Then
.TextFrame.TextRange.Font.Size = sFontSize - 1
Else
MsgBox "Table font size limit of " & sFontSize & " reached", vbCritical + vbOKOnly, "Minimum Font Size"
Exit Sub
End If
End With
' Resize the table (effectively like dragging the bottom edge and allowing PowerPoint to set the table size to the text.
.Parent.Height = 0
Next
Next
Loop
End With
End Sub
I'm making an add records form for a spreadsheet of mine, and let's say that I want one of the controls to be a dropdown that is populated by unique entries under a certain column "type". However, I want to also make it such that the dropbox always has a initial option to "add new type" and upon such selection, it becomes a regular text box. How would I do this in VBA?
You cannot change a control type at run time. The easiest thing to do is create a combo box and a text box. Set the text box visibility to false. Then in the onchange event of the combo box your code will unhide the text box and hide the combo box. You will also need a save button so that when it is clicked it will add the option to the drop down, clear the text box, hide the text box, hide the button and unhide the drop down.
Okay, so here's my idea of how to tackle this.
Create 2 hidden elements (Visibility = False), one a TextBox and one a CommandButton.
Populate your ComboBox with the values from the sheet under column "type"
Add one more entry AddItem with wording such as "Add new item..."
When the user selects "Add new item...", change the Visibility of the TextBox & CommandButtons to True
When the user clicks the CommandButton, add the phrase to the column and add a new element to the ComboBox
I have created a mockup UserForm and code that does a little more than just this; it also styles the user entry to sentence case (consistency purposes) and checks to make sure the value isn't already in the column.
Excel Sheet with "type" column
UserForm with name labels
UserForm Code
Private Sub bAdd_Click()
Dim str As String
Dim rng As Range
Dim ro As Integer
'Makes sure there is an entry, adds it to the Sheet and then updates the dropdown
If Len(Me.tbNew) > 0 Then
'Converts user entry to "Sentance Case" for better readability
str = StrConv(Me.tbNew, vbProperCase)
'Finds out if the entry already exists
Set rng = Sheets(1).Range(Sheets(1).Cells(2, 1), Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1))
On Error Resume Next
Err.Number = 0
'Searches for duplicate; if found, then ListIndex of cbColor is modified without inserting new value (prevents duplicates)
ro = rng.Find(str, LookIn:=xlValues, LookAt:=xlWhole).Row
Debug.Print Err.Number
'Ensures a user doesn't add the same value twice
If Err.Number > 0 Then
Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row + 1, 1) = str
Me.cbColor.AddItem StrConv(Me.tbNew, vbProperCase), Me.cbColor.ListCount - 1
Me.cbColor.ListIndex = Me.cbColor.ListCount - 2
Else
Me.cbColor.ListIndex = ro - 2
End If
'Resets and hides user form entries
Me.tbNew = vbNullString
Me.tbNew.Visible = False
Me.bAdd.Visible = False
End If
End Sub
Private Sub bClose_Click()
Unload Me
End Sub
Private Sub cbColor_Change()
'Visibility is toggled based on if the user selected the last element in the dropdown
Me.bAdd.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
Me.tbNew.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
End Sub
Private Sub UserForm_Initialize()
'Populate from the sheet
For a = 2 To Sheets(1).Cells(Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1).Row
Me.cbColor.AddItem Sheets(1).Cells(a, 1)
Next
'Add option for new type
Me.cbColor.AddItem "Add new type..."
End Sub