I'm trying to change the Tag of a bunch of CheckBoxes (Content Control), so the tags match the CheckBox row position on a table.
Ex.: If CheckBoxes are positioned on row 4, i want all of them to have the same tag (like Row4,or something like that).
Is this possible or the Tag property is only for reading purpose?
I'll be gratefull on any advise. Thanks in advance!
Image of the table bellow
A basic example:
Sub Tester()
Dim cc As ContentControl, i As Long, tbl As Table, rw As Row
Set tbl = ThisDocument.Tables(1)
For Each rw In tbl.Rows
i = i + 1
For Each cc In rw.Range.ContentControls
If cc.Type = wdContentControlCheckBox Then
Debug.Print cc.Tag
cc.Tag = "Row_" & i
End If
Next cc
Next rw
End Sub
Related
I have a table in Word built from repeating section content control. There are text content controls in cells of repeating section of CC.
I am able to give font color based on the text; but I couldn't change the shading of the cell except the last row.
In debug session, whether I see correct row and column number, Shading.BackgroundPatternColor does not change the color. Surprisingly, it works on the last row of the table.
Dim CC As ContentControl
Dim TableNum As Long, RowNum As Long, ColNum As Long
For Each CC In ActiveDocument.ContentControls
If CC.Tag = "tagPriority" Then
If CC.Range.Text = "Critical" Then
CC.Range.Font.TextColor = wdColorAutomatic
If CC.Range.Information(wdWithInTable) Then
TableNum = Me.Range(0, CC.Range.End).Tables.Count
RowNum = CC.Range.Information(wdStartOfRangeRowNumber)
ColNum = CC.Range.Information(wdStartOfRangeColumnNumber)
ActiveDocument.Tables(TableNum).Cell(RowNum, ColNum).Shading.BackgroundPatternColor = wdColorDarkRed
End If
...
Also, I got help from the code in stackoverflow
After changing
TableNum = Me.Range(0, CC.Range.End).Tables.Count
to
TableNum = ActiveDocument.Range(0, CC.Range.End).Tables.Count
it worked for me. I put your code in a standard module so YMMV if you have your code in a document event handler in the ThisDocument module.
Of course there is another method to get the table which also works
Dim tbl As Table
Set tbl = CC.Range.Tables(1)
tbl.Cell(RowNum, ColNum).Shading.BackgroundPatternColor = wdColorDarkRed
EDIT:
The code I used:
Sub AddCellShading()
Dim CC As ContentControl
Dim tbl As Table, RowNum As Long, ColNum As Long
For Each CC In ActiveDocument.ContentControls
If CC.Tag = "tagPriority" Then
If CC.Range.Text = "Critical" Then
CC.Range.Font.TextColor = wdColorAutomatic
If CC.Range.Information(wdWithInTable) Then
Set tbl = CC.Range.Tables(1)
RowNum = CC.Range.Information(wdStartOfRangeRowNumber)
ColNum = CC.Range.Information(wdStartOfRangeColumnNumber)
tbl.Cell(RowNum, ColNum).Shading.BackgroundPatternColor = wdColorDarkRed
End If
End If
End If
Next CC
End Sub
The result:
I have created a listbox which can be filtered according to keyword in textbox. It works if I do it normally. However, it stopped working when the list is a dependent source. (The listbox value is like INDIRECT() of F1 and I'm trying to filter that INDIRECT list)
I have 3 lists as shown in the image (A, B, D). D is a list of A without duplicates. the listbox("lbxCustomers") in Userform2 uses a dependent rowsource according to word selected at Cell F2. [It works until here]
The values in the listbox will be filtered according to keyword in textbox("tbxFind"). I'm getting an error at this line ".List = vaCustNames". I tried to change it into a normal range (sheet1.range(...)) and it works but the list is not a dependent list of F1.
image
Private Sub UserForm_Initialize()
Me.lbxCustomers.RowSource = Range("F2").Value
End Sub
Private Sub tbxFind_Change()
Dim i As Long
Dim sCrit As String
Dim vaCustNames As Variant
vaCustNames = Range("F2").Value
Debug.Print Range("F2").Value
sCrit = "*" & UCase(Me.tbxFind.Text) & "*"
With Me.lbxCustomers
.RowSource = ""
'Start with a fresh list
.List = vaCustNames
'.List = Sheet1.Range("B2:B13").Value 'tested with range and worked
For i = .ListCount - 1 To 0 Step -1
'Remove the line if it doesn’t match
If Not UCase(.List(i)) Like sCrit Then
.RemoveItem i
End If
Next i
End With
End Sub
Hello everyone I have two listboxes. The first listbox contains all the items to choose from. After selecting an item, a user clicks on an 'ADD' command button to copy that value onto the range of the second listbox. I believe most of you have seen similar add/remove listboxes.
Both listboxes were created by inserting controls and they are populated by an input range of items on a hidden worksheet.
Here is my problem: adding names is works fine, however the 'remove' procedure I created seems to take a long time to complete since the list of items can be more than 200 items.
I use the following code to match a selected listbox value with the input range value and then it clears the contents of the cell in the input range:
Sub remove()
Dim r As Long
Dim al As ListBox
Dim d As Range
Dim dd As Range
Dim allpick As Worksheet
Set al = Worksheets("LISTBOX").ListBoxes("listselected")
Set allpick = Worksheets("columns")
Set dd = allpick.Range("selectedNAMES")
With al
For r = 1 To .ListCount
If .selected(r) Then
For Each d In dd
If d.Value = .List(r) Then
d.ClearContents
End If
Next d
End If
Next r
End With
End Sub
Is there an alternative code or structure I could use so that it doesn't take so long to complete?
I used the find function stated by commenters and wrote the code below. It is much faster and is exactly what I wanted. However, I didn't know what to put after "IF CELL IS NOTHING THEN" so i just used calculate. Any suggestions?
Dim r As Long
Dim al As ListBox
Dim strNAME As String
Dim names As Worksheet
Set names = Worksheets("names")
Set al = Worksheets("HOME").ListBoxes("selectednames")
With al
For r = 1 To .ListCount
If .Selected(r) Then
strNAME = .List(r)
Set cell = names.Range("currentnames").Find(What:=strNAME)
If cell Is Nothing Then
Calculate
Else: cell.ClearContents
End If
End If
Next r
End With
I'm looking for a way to delete empty rows in comments using VBA. I have an Excel file with loads of corrupted comments, containing empty rows, and going through them one by one is not an option.
I haven't identified a command for editing rows in comments, and don't know where to start, so I don't have any code to show you guys. But I'm thinking in the line of:
For Each comment In ActiveSheet.Comments
"REMOVE EMPTY ROWS" <-- What to put here?
Next comment
Hope that you can help me anyway!
EDIT:
All my empty lines are at the end of the comment like this:
I found the answer. It seems that it's not empty rows, it's just the size of the comment that was changed somehow. So this code fixed it:
Sub Comments_AutoSize()
Dim MyComments As Comment
Dim lArea As Long
For Each MyComments In ActiveSheet.Comments
With MyComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 200
.Shape.Height = (lArea / 200) * 1.1
End If
End With
Next
End Sub
Suppose your comment looks like this
You could try this
Sub RemoveEmptyLinesInComments()
Dim c As Comment
For Each c In ActiveSheet.Comments
c.Text Text:=Replace(c.Text, vbLf, Chr(32))
Next c
End Sub
to achieve
Update
Ok, after you've edited your question and changed the meaning with the provided details Ive come up with another code as a solution. Try
Sub RemoveEmptiesFromComments()
Dim c As Comment
For Each c In ActiveSheet.Comments
Dim v As Variant
v = Split(c.Text, Chr(32))
Dim i As Long, s As String
For i = LBound(v) To UBound(v) - 1
s = s & Chr(32) & v(i)
Next i
Dim rng As Range
Set rng = c.Parent
c.Delete
rng.AddComment Text:=s
rng.Comment.Shape.TextFrame.AutoSize = True
Next c
End Sub
I'm trying to add comments to the table rows. the idea is that you select a table and the macro would add a comment to every row.
say you have a string followed by an integer in the comment content.
example comment content would be :
comment1
comment2
comment3
Note that the contents of the comments are important , as they play a vital role.
Here is what I got so far , if some one has already got this figured out , please help me out
Sub CallAddNewComment()
Dim i As Integer
i = ActiveDocument.Tables(1).Rows.Count
Do Until (i > 1)
Call AddNewComment(strText:="This is a test comment.")
Loop
End Sub
Sub AddNewComment(ByVal strText As String)
Comments.Add Row = i, Text:=strText
End Sub
Sub Tester()
Dim tbl As Table, i As Long
For Each tbl In ActiveDocument.Tables
For i = 1 To tbl.Rows.Count
ActiveDocument.Comments.Add _
tbl.Rows(i).Cells(1).Range, "Comment" & i
Next i
Next tbl
End Sub