I have a document with a large number of checkboxes spread around the text and I would like to replace all checkboxes with characters.
Example:
If checkbox is checked then replace it with "A"
If checkbox is not Checked then replace it with "O"
For the time being I can only replace all checkboxes with a letter regardless of their state (checked or unchecked). I need to improve my macro so it recognizes the state of the checkbox and replacing it with the right litteral.
Thanks in advance
Sub Checkbox_Replacement()
Dim i As Long, Rng As Range
With ActiveDocument
For i = .FormFields.Count To 1 Step -1
With .FormFields(i)
If .Type = wdFieldFormCheckBox Then
Set Rng = .Range
.Delete
Rng.Text = "A"
End If
End With
Next
Set Rng = Nothing
End With
End Sub
Expected Result
If checkbox is checked then replace it with "A"
If checkbox is not Checked then replace it with "O"
Actual Result
All checkboxes are replaced with "A"
You need a second If..Else block to check the condition of the checkbox:
If .Type = wdFieldFormCheckBox Then
Set Rng = .Range
If .CheckBox.Value = True Then
Rng.Text = "A"
Else
Rng.Text = "O"
End If
.Delete
End If
The answer to the problem was to remove the .Delete
Sub Checkbox_Replacement()
Dim i As Long, Rng As Range
With ActiveDocument
For i = .FormFields.Count To 1 Step -1
With .FormFields(i)
If .Type = wdFieldFormCheckBox Then
Set Rng = .Range
If .CheckBox.Value = True Then
Rng.Text = "A"
Else
Rng.Text = "O"
End If
End If
End With
Next
Set Rng = Nothing
End With
End Sub
Related
I need to send an document as email body. The document contains several { FORMCHECKBOX } fields, which are either selected or not. Now, whenever I actually send the email, the checkboxes are not included at all. Because of this issue, I thougth about replacing the checkboxes with "Yes" or "No", depending on the selection.
I found this code, to replace all checkboxes, but it doesn't care for the actual selection:
Sub ChkBxClr()
Dim i As Long, Rng As Range
With ActiveDocument
For i = .FormFields.Count To 1 Step -1
With .FormFields(i)
If .Type = wdFieldFormCheckBox Then
Set Rng = .Range
.Delete
Rng.Text = "[__]"
End If
End With
Next
Set Rng = Nothing
End With
End Sub
Also this code changes the whole document and not just the email body, which I would like to prevent.
The overall code:
Sub SendEmail()
Dim Subject As String
Dim From As String
On Error Resume Next
Selection.GoTo What:=wdGoToBookmark, Name:="From"
From = Selection.Text
Subject = "Title"
Call ChkBxClr
ActiveWindow.EnvelopeVisible = True
With ActiveDocument.MailEnvelope.Item
.To = "<some mail address>"
.Subject = Subject
.Send
End With
End Sub
Sub ChkBxClr()
Dim i As Long, Rng As Range
With ActiveDocument
For i = .FormFields.Count To 1 Step -1
With .FormFields(i)
If .Type = wdFieldFormCheckBox Then
Set Rng = .Range
.Delete
Rng.Text = "[__]"
End If
End With
Next
Set Rng = Nothing
End With
End Sub
So the question is, how can I either display the checkboxes within the email body or replace the checkboxes (preferably only in message body) with a text, depending on the selection?
i am still trying to fix a problem with a table in word. In my table are three columns and many rows. In the row an explanatory text is written in italic. Now I want to delete rows in the tables of my worddocument where the font is italic.
I tried to use the macro recorder but it wont work. I would really appreciate your help.
For that you might use a macro like:
Sub Demo()
Application.ScreenUpdating = False
Dim r As Long, Rng As Range
With Selection
If .Information(wdWithInTable) = False Then Exit Sub
With .Tables(1)
For r = .Rows.Count To 1 Step -1
Set Rng = .Cell(r, 1).Range
With Rng
.End = .End - 1
If .Font.Italic = True Then .Rows(1).Delete
End With
Next
End With
End With
Application.ScreenUpdating = True
End Sub
where the 1 in .Cell(r, 1).Range indicates the column # of the italicised text.
Public Function highlight_text(Search)
Dim rng As Range
Dim cell As Range
Set rng = Range("A2:H32")
For Each cell In rng
If cell.text = Search Then
cell.Font.ColorIndex = 3
cell.Font.Name = "Arial"
cell.Font.Size = 14
cell.Font.Bold = True
Else
cell.Font.Bold = False
cell.Font.Size = 11
cell.Font.ColorIndex = 1
End If
Next cell
End Function
The above function is called on 'mouseover' a cell, it manages to set the proper cells to RED color but it won't make the text bold
You cannot call a function from the worksheet and change the format of a cell.
(The fact that even the color is changing is perplexing)
As this does not need to be a function, it does not return anything and you cannot use it from the worksheet, we can make it a sub:
Public Sub highlight_text(Search)
Dim rng As Range
Dim cell As Range
Set rng = Range("A2:H32")
For Each cell In rng
If cell.Text = Search Then
cell.Font.ColorIndex = 3
cell.Font.Name = "Arial"
cell.Font.Size = 14
cell.Font.Bold = True
Else
cell.Font.Bold = False
cell.Font.Size = 11
cell.Font.ColorIndex = 1
End If
Next cell
End Sub
Use a Worksheet_Change Event(or some other event) to call the sub:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A2:H32")) Is Nothing Then
highlight_text (Target.Text)
End If
End Sub
Put both of these in the worksheet code in which you want the code to run.
This will now highlight the like cells as you click on any cell in the range.
This is a good solution in this case. But I am confused by the statement that you cannot change to format of a cell in a function. Tried this to confirm. It works fine.
Function boldit() As String
Dim theCell As String
theCell = "Q8"
Range(theCell).Value = "XorY"
Range(theCell).Font.Color = RGB(255, 0, 0)
Range(theCell).Font.Bold = True
End Function
The reason I'm interested is that in a real function I have written the same .Font.Bold statement does not work (while the .Font.Color does)
Any other idea why .Font.Bold=True might not work
So I am working on a word template which needs to automatically write specific data in specific places of the document. Now I Need to write and mathematical equation in a cell (for example: 〖∆U=α〗_(steel )∙ ∆T ∙ ∆L_vp) I know I need to replace certain characters with a ChrW(###). But I cant seem to figure out how to write the formula in the right format in the cell (specific location in the code below "my equation here". Note this is only one cell as an example but there are more cell that are filled under the with activedocument.tables. Can anybody here help me out?
'Selecteren Table
With ActiveDocument.Tables(TableNum)
'Select cell to write data in
With .cell(r, 1)
'data to be written in cell
With .Range
.Text = "My Equation here"
End With
End With
end with
Just to clarify the use of the with part of the code
'Select right table
With ActiveDocument.Tables(TableNum)
'add row when a Tee is already inserted
If insertrow = True Then
ActiveDocument.Tables(TableNum).cell(r, 1).Select
Selection.InsertRows (1)
End If
'Select cell and write data
With .cell(r, 1)
With .Range
'lettertype updaten voor betreffende cell
With .Font
.Bold = True
End With
.Text = TxtTstuk.Value & ":"
End With
End With
'Select cell and write data
With .cell(r, 2)
With .Range
.Text = "Type T-stuk:"
End With
End With
'Select cell and write data
With .cell(r, 3)
With .Range
.Text = TxtTType.Value
End With
End With
'add 1 to counter
r = r + 1
'Add row
If insertrow = True Then
ActiveDocument.Tables(TableNum).cell(r, 1).Select
Selection.InsertRows (1)
Else
ActiveDocument.Tables(TableNum).Rows.Add
End If
'Select cell and write data
With .cell(r, 2)
With .Range
.Text = "Diameter doorgaande leiding:"
End With
End With
and so on...
Since you're only using a single property, what is the purpose of nested With?
Modify it to suit your needs.
Sub WriteEq()
Dim objRange As Range
Dim objEq As OMath
With ActiveDocument
Set objRange = .Tables(1).Cell(1, 1).Range
objRange.Text = "Celsius = (5/9)(Fahrenheit – 32)"
Set objRange = .OMaths.Add(objRange)
End With
Set objEq = objRange.OMaths(1)
objEq.ConvertToMathText
objEq.BuildUp
End Sub
In a VBA Word macro, I'd like to get a Field-object for the field which contains the cursor.
The obvious try fails:
Private Sub Try1()
MsgBox Selection.Fields.Count
End Sub
The array is empty. Then I tried:
Private Sub Try2()
Dim oRange As Range
Set oRange = Selection.GoTo(What:=wdGoToField)
MsgBox oRange
End Sub
The cursor does not move, the message is empty.
I can iterate over ActiveDocument.Fields, compare the ranges and find the containing fiels. But probably there is a simple direct way?
My current production code with iteration over Document.Fields:
Sub Test()
Dim oField As Field
Set oField = FindWrappingField(Selection.Range)
If oField Is Nothing Then
MsgBox "not found"
Else
MsgBox oField
End If
End Sub
Private Function FindWrappingField(vRange As Range)
Dim oField As Field
Dim nRefPos As Long
' If selection starts inside a field, it also finishes inside.
nRefPos = vRange.Start
' 1) Are the fields sorted? I don't know.
' Therefore, no breaking the loop if a field is too far.
' 2) "Code" goes before "Result", but is it forever?
For Each oField In vRange.Document.Fields
If ((oField.Result.Start <= nRefPos) Or (oField.Code.Start <= nRefPos)) And _
((nRefPos <= oField.Result.End) Or (nRefPos <= oField.Code.End)) Then
Set FindWrappingField = oField
Exit Function
End If
Next oField
Set FindWrappingField = Nothing
End Function
The following function determines whether the selection spans or is within a field.
Function WithInField(Rng As Word.Range) As Boolean
' Based on code by Don Wells: http://www.eileenslounge.com/viewtopic.php?f=30&t=6622
' Approach : This procedure is based on the observation that, irrespective of _
a field's ShowCodes state, toggling the field's ShowCodes state _
twice collapses the selection to the start of the field.
Dim lngPosStart As Long, lngPosEnd As Long, StrNot As String
WithInField = True
Rng.Select
lngPosStart = Selection.Start
lngPosEnd = Selection.End
With Selection
.Fields.ToggleShowCodes
.Fields.ToggleShowCodes
' Test whether the selection has moved; if not, it may already have been _
at the start of a field, in which case, move right and test again.
If .Start = lngPosStart Then
.MoveRight
.Fields.ToggleShowCodes
.Fields.ToggleShowCodes
If .Start = lngPosStart + 1 Then
WithInField = False
End If
End If
End With
End Function
You can use the function with code like:
Sub TestWithInField()
Dim Rng As Word.Range, c As Word.Range, StrRslt As String
Set Rng = Selection.Range
For Each c In Rng.Characters
StrRslt = StrRslt & c.Text & ",WithInField:" & WithInField(Rng:=c) & vbCr
Next
Rng.Select
MsgBox StrRslt
End Sub
I had the same problem and I solved with the code below:
Sub Test()
NumberOfFields = Selection.Fields.Count
While NumberOfFields = 0
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
NumberOfFields = Selection.Fields.Count
Wend
End Sub
Of course, I have to know that the cursor is in a field.
Apparently, when you select a range extending to the right, at some moment the field will be selected. The end of the range doesn't count (it not acuses a field range)
I use this code
Sub GetFieldUnderCursor()
Dim NumberOfFields As Integer
Dim oFld As Field
Dim TextFeld As String
Dim Typ As Integer
Dim pos As Integer
Dim NameOfField As String
'update field. Cursor moves after the field
Selection.Fields.Update
'select the field
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'check if there is a field
NumberOfFields = Selection.Fields.Count
If NumberOfFields = 0 Then
MsgBox "No field under cursor"
Exit Sub
End If
Set oFld = Selection.Fields(1)
TextFeld = Trim(oFld.Code.Text)
Typ = oFld.Type '85 is DOCPROPERTY, 64 is DOCVARIABLE
If Typ = 85 Or Typ = 64 Then
pos = InStr(15, TextFeld, " ")
If pos > 0 Then
NameOfField = Trim(Mid(TextFeld, 12, pos - 11))
MsgBox NameOfField
End If
End If
End Sub