Is there any simple and universal way to find out whether or not any character style has been assigned within the selected text?
Presently I'm using a function, but it is not independent of the MS Word language version:
Function AnyCharacterStyleAssigned()
'elicit the name of the default paragraph font
V_AppLang = Application.Language
If V_AppLang = 1031 Then
Vst_Default = "Absatz-Standardschriftart"
ElseIf V_AppLang = 1045 Then
Vst_Default = "Domy" & ChrW(347) & "lna czcionka akapitu"
ElseIf V_AppLan = 1033 Then
Vst_Default = "Default Paragraph Font"
Else
MsgBox prompt:="this script doesn't work for this language version of Word", Buttons:=vbOKOnly
End
End If
'search for the default paragraph font within the selection range
Set R_Range = Selection.Range
R_Range.Find.ClearFormatting
R_Range.Find.Style = Vst_Default
R_Range.Find.Execute findtext:="", Forward:=True, Wrap:=wdFindStop, Format:=True
AnyCharacterStyleAssigned = IIf(R_Range.Start >= Selection.End, False, True)
End Function
Just use built-in style constant:
Function AnyCharacterStyleAssigned()
'search for the default paragraph font within the selection range
Set R_Range = Selection.Range
R_Range.Find.ClearFormatting
R_Range.Find.Style = ActiveDocument.Styles(wdStyleDefaultParagraphFont)
R_Range.Find.Execute findtext:="", Forward:=True, Wrap:=wdFindStop, Format:=True
AnyCharacterStyleAssigned = IIf(R_Range.Start >= Selection.End, False, True)
End Function
A better test would be the following. The code you have, if the selection doesn't have the style, the selection never changes, so you will always have a True case.
Public Sub StyleTest()
Dim R_Range As Range
Set R_Range = Selection.Range
R_Range.Find.ClearFormatting
R_Range.Find.Style = "Strong"
Dim AnyCharacterStyleAssigned As Boolean
AnyCharacterStyleAssigned = False
If R_Range.Find.Execute(Forward:=True, Wrap:=wdFindStop, Format:=True) = True Then
R_Range.Select
AnyCharacterStyleAssigned = True
End If
End Sub
Related
Pretend I have a sentence like this:
"THIS IS MY CASE:"
":" is regular and I want to change its style like The character before it(E). But I don't know which object to use in this case. I want to find The index of ":" then I check Font Style of character before it (index - 1) if they are different I will change Font Style of charater ":" (index) to index - 1.
I try TextFrame.TextRange.Font but there was something wrong.
Please help me, thank in advance.
Try this code:
Sub test()
Dim sh As Shape, EF As Font, textLen As Integer
For Each sh In ActivePresentation.Slides(1).Shapes
If sh.HasTextFrame Then
textLen = sh.TextFrame.TextRange.Length
If textLen > 1 Then
Set EF = sh.TextFrame.TextRange.Characters(textLen - 1, 1).Font
With sh.TextFrame.TextRange.Characters(textLen, 1).Font
.Name = EF.Name
.Color = EF.Color
.Size = EF.Size
.Italic = EF.Italic
.Bold = EF.Bold
.Underline = EF.Underline
' and other required properties
End With
End If
End If
Next
End Sub
I am implementing a Userform and wish to include some checks on the input data prior to running the Userform. In particular, check all inputs into the Userform textboxs are numerical, although it is valid a textbox is blank or Null. I have tried implementing the following:
Select Case KeyAscii
Case 0, 46, 48 To 57
Case Else
MsgBox "Only numbers allowed"
End Select
But this does not work.
Please, ideas?
Thank you very much!!!!!!!!!
Maybe bit long winded - I usually use a class module and the tag property on the control to decide what can be entered in a textbox.
Create a form with four text boxes.
Give the text boxes these tags:
1;CDBL
2;CINT
3;CSTR
4;CSENTENCE
The numbers are the columns to paste the values into when the form is saved (I haven't described that bit here).
The text describes what can be entered in the textbox - CDBL is numeric with 2 decimal places, CINT is numeric with 0 decimal places, CSTR is for Proper text and CSENTENCE is for sentence text.
Create a class module called clsControlText.
Add this code to the class module:
Public WithEvents txtBox As MSForms.TextBox
Private Sub txtBox_Change()
Static LastText As String
Static SecondTime As Boolean
Const MaxDecimal As Integer = 2
Const MaxWhole As Integer = 1
With txtBox
If InStr(.Tag, ";") > 0 Then
Select Case Split(.Tag, ";")(1)
Case "CDBL", "CCur"
'Allow only numbers with <=2 decimal places
If Not SecondTime Then
If .Text Like "[!0-9.-]*" Or Val(.Text) < -1 Or _
.Text Like "*.*.*" Or .Text Like "*." & String$(1 + MaxDecimal, "#") Or _
.Text Like "?*[!0-9.]*" Then
Beep
SecondTime = True
.Text = LastText
Else
LastText = .Text
End If
End If
SecondTime = False
Case "CINT"
'Allow only whole numbers.
If .Text Like "[!0-9]" Or Val(.Text) < -1 Or .Text Like "?*[!0-9]*" Then
Beep
.Text = LastText
Else
LastText = .Text
End If
Case "CSTR"
'Convert text to proper case.
.Text = StrConv(.Text, vbProperCase)
Case "CSENTENCE"
'Convert text to sentence case (capital after full-stop).
.Text = ProperCaps(.Text)
Case Else
'Allow anything.
End Select
End If
End With
End Sub
Private Function ProperCaps(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object
Set objRegex = CreateObject("vbscript.regexp")
strIn = LCase$(strIn)
With objRegex
.Global = True
.ignoreCase = True
.Pattern = "(^|[\.\?\!\r\t]\s?)([a-z])"
If .Test(strIn) Then
Set objRegMC = .Execute(strIn)
For Each objRegM In objRegMC
Mid$(strIn, objRegM.firstindex + 1, objRegM.Length) = UCase$(objRegM)
Next
End If
ProperCaps = strIn
End With
End Function
Add this code to the user form:
Private colTextBoxes As Collection
Private Sub UserForm_Initialize()
Dim ctrlSelect As clsControlText
Dim ctrl As Control
Me.Caption = ThisWorkbook.Name
Set colTextBoxes = New Collection
For Each ctrl In Me.Controls
Select Case TypeName(ctrl)
Case "TextBox"
Set ctrlSelect = New clsControlText
Set ctrlSelect.txtBox = ctrl
colTextBoxes.Add ctrlSelect
End Select
Next ctrl
End Sub
NB: Not all this code is mine. I found ProperCaps and the code for CDBL elsewhere on this site - or maybe MrExcel.
You could use a basic LIKE or Regexp
Sub Test()
Debug.Print StrCheck("")
Debug.Print StrCheck("hello kitty")
Debug.Print StrCheck("4156")
End Sub
function
Function StrCheck(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "\d+"
'vaidate empty string
If Len(Trim(strIn)) = 0 Then
StrCheck = True
Else
'validate whether non-empty string is numeric
StrCheck = objRegex.Test(strIn)
End If
End Function
I've a macro code (created by Davy C) to find paragraph styles and add comment for each one if found. I need to improve this code. I want to run this macro code only paragraphs and need to skip/ignore tables when found. How do I do this?
Sub CheckKeepWithNext01()
Const message As String = "Check Keep With Next"
Const styleMask As String = "Bold + KWN"
Dim paragraphCount As Integer
Dim i As Integer
Dim currentStyle As String
Dim doc As Document
Set doc = ActiveDocument
paragraphCount = doc.Paragraphs.count
Do While i < paragraphCount
i = i + 1
If doc.Paragraphs(i).Range.Bold = True Then
If doc.Paragraphs(i).KeepWithNext = False Then
currentStyle = doc.Paragraphs(i).Range.Style
If Left(currentStyle, Len(styleMask)) <> styleMask Then
doc.Paragraphs(i).Range.Select
Selection.Comments.Add Range:=Selection.Range
Selection.TypeText Text:=message
End If
End If
End If
Loop
Set doc = Nothing
End Sub
See below screenshot for more clarity:
I've got the answer!
If doc.Paragraphs(i).Range.Tables.count = 0 Then
I have an exported Word document in which tables constructed by a database extractor have space between wrapped lines in cells that I can remove by selecting the table and using the paragraph dialog box, but there are many tables and I want to automate this.
All I have to do after selecting all the tables in the document (which I can do with VBA) is set Add Space Before and Add Space After both = 0, which I think, secretly also sets the AddSpaceBeforeAuto = AddSpaceAfterAuto = False.
So I started with a simple select subroutine:
Sub selecttables()
Dim mytable As Table
Application.ScreenUpdating = False
For Each mytable In ActiveDocument.Tables
mytable.Range.Editors.Add wdEditorEveryone
Next
ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
ActiveDocument.DeleteAllEditableRanges (wdEditorEveryone)
Application.ScreenUpdating = True
End Sub
This works fine and leaves all my tables selected. All I want to do now is set the appropriate ParagraphFormat members to mimic my setting of these properties in the Paragraph Dialog to zero and false.
I tried three approaches:
1. Set the values globally for the Normal style (which all the tables use)
2. Set the values for each table as they are selected
3. Set the values on the total selection, after all the tables are selected.
When I do this manually after selecttables() executes, I am doing method 3.
The function below actually tries all three methods. I have selectively commented them out and discovered that no one of the methods works and doing all three doesn't help any.
I tried both "With Selection.Range.Style.ParagraphFormat" and "With Selection.Range.ParagraphFormat" for METHOD 3, but neither worked.
I would also like to set the table property, "Allow row to break across pages" to False (because, seriously, the default value of True is really dumb!) and can't figure how to do that either.
Here is the function:
Sub FixTables()
Dim mytable As Table
Dim i As Integer
Application.ScreenUpdating = False
' METHOD 1:
ActiveDocument.Styles("Normal").ParagraphFormat.Space1
ActiveDocument.Styles("Normal").ParagraphFormat.SpaceAfter = 0
ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBefore = 0
ActiveDocument.Styles("Normal").ParagraphFormat.SpaceAfterAuto = False
ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBeforeAuto = False
For Each mytable In ActiveDocument.Tables
' METHOD 2:
With mytable.Style.ParagraphFormat
.Space1
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
End With
mytable.Range.Editors.Add wdEditorEveryone
Next
ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
ActiveDocument.DeleteAllEditableRanges (wdEditorEveryone)
'
With Selection.Style.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
End With
Application.ScreenUpdating = True
End Sub
I botched METHOD 3, by referring to the table reference I used in
METHOD 2 rather than the current Selection. Here is the correct answer:
Sub FixTables()
Dim mytable As Table
Application.ScreenUpdating = False
For Each mytable In ActiveDocument.Tables
mytable.Range.Editors.Add wdEditorEveryone
Next
ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
ActiveDocument.DeleteAllEditableRanges (wdEditorEveryone)
With Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
Application.ScreenUpdating = True
End Sub
I'm trying to programmatically change "Don't add space between paragraphs of the same style." To approach the problem, I recorded a macro during which I opened the Paragraph dialog box (Page Layout > Paragraph), checked the checkbox (don't add space) and a macro during which I unchecked the checkbox (add space). Neither affects "Don't add space between paragraphs of the same style" . . . and they have identical code:
Sub AddSpaceBetweenParagraphsOfSameStyle()
'
' AddSpaceBetweenParagraphsOfSameStyle Macro
' Add space between paragraphs of the same style.
'
With Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0.5)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 12
.SpaceBeforeAuto = False
.SpaceAfter = 12
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = LinesToPoints(1)
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(-0.25)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With
End Sub
Sub RemoveSpaceBetweenParagraphsOfSameStyle()
'
' RemoveSpaceBetweenParagraphsOfSameStyle Macro
' Remove space between paragraphs of the same style.
'
With Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0.5)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 12
.SpaceBeforeAuto = False
.SpaceAfter = 12
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = LinesToPoints(1)
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(-0.25)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With
End Sub
The code produced by the macro recorder is long, so I reduced it to a minimal version that I've verified also fails to affect "Don't add space between paragraphs of the same style":
Sub AddSpaceBetweenParagraphsOfSameStyle()
'
' AddSpaceBetweenParagraphsOfSameStyle Macro
' Add space between paragraphs of the same style.
'
End Sub
Sub RemoveSpaceBetweenParagraphsOfSameStyle()
'
' RemoveSpaceBetweenParagraphsOfSameStyle Macro
' Remove space between paragraphs of the same style.
'
End Sub
I looked at the documentation for ParagraphFormat and searched for a relevant property but found nothing that works. How can I programmatically change "Don't add space between paragraphs of the same style"?
This property is connected with Style, not with Paragraph (which suggests window title where you set this property). This is code which you look for:
ActiveDocument.Styles("Normal").NoSpaceBetweenParagraphsOfSameStyle = False
ActiveDocument.Styles("Normal").NoSpaceBetweenParagraphsOfSameStyle = True
The macro recorder recognizes changing spacing but not "Don't add space between paragraphs of the same style" (Page Layout > Paragraph). To change paragraph formatting without modifying a built-in style (or creating a new style), I can use Selection.Style:
Selection.Style.NoSpaceBetweenParagraphsOfSameStyle = False
or fall back to the built-in dialog:
With Dialogs(wdDialogFormatParagraph)
.Before = 12
.After = 12
.NoSpaceBetweenParagraphsOfSameStyle = False
.Execute
End With
winword.ActiveDocument.Styles["Normal"].NoSpaceBetweenParagraphsOfSameStyle = true;
winword.ActiveDocument.Styles["List Paragraph"].NoSpaceBetweenParagraphsOfSameStyle = false;
On word doc press Alt+Ctl+Shift+S to check all the styles
If anyone stumbles on this and is looking for a C# example, this is what worked for me. Hope it helps someone else.
string signaturesPath = Environment.GetFolderPath(System.Environment.SpecialFolder.ApplicationData) + #"\Microsoft\Signatures\";
Directory.CreateDirectory(signaturesPath + "Test");
Word.Application oWord = new Word.Application();
//oWord.Visible = true;
Word.Document oDoc = oWord.Documents.Add();
//Insert a paragraph at the beginning of the document.
Word.Paragraph paragraph1 = oDoc.Content.Paragraphs.Add();
object oStyleName1 = Word.WdBuiltinStyle.wdStyleNormal;
//NoSpaceBetweenParagraphsOfSameStyle set on style then assign to doc
oWord.ActiveDocument.Styles[oStyleName1].NoSpaceBetweenParagraphsOfSameStyle = true;
//Setting style on paragraph here
paragraph1.Format.set_Style(oStyleName1);
paragraph1.Range.Font.Bold = 1;
paragraph1.Range.InsertAfter("Testing 123");
//Save as htm
object htmlFormat = (int)Word.WdSaveFormat.wdFormatFilteredHTML;
oDoc.SaveAs2(signaturesPath + #"\test.htm", htmlFormat);
oWord.Quit();