Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 06-04-2023, 07:00 PM
Cendrinne's Avatar
Cendrinne Cendrinne is offline Need help with a script with Selection and If for Font Size < 8? Windows 10 Need help with a script with Selection and If for Font Size < 8? Office 2019
Competent Performer
Need help with a script with Selection and If for Font Size < 8?
 
Join Date: Aug 2019
Location: Montreal Quebec Canada
Posts: 190
Cendrinne is on a distinguished road
Default Need help with a script with Selection and If for Font Size < 8?

I feel I'm so close but searching doesn't come up with solution



I have
Code:
Sub TESTS_If_Font_size_below_8p5_put_Font_size_8p5()
Dim Rng As Range

With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Execute
  End With
   Do While .Find.found = True
      If .Font.Size < 8.5 Then

           .Find.Replacement.Font.Size = 8.5
           
      End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
End Sub
Why it does nothing? No error message but no action

Need advice please

Unless it's not doable? I keep searching.

C
Reply With Quote
  #2  
Old 06-04-2023, 07:47 PM
BrianHoard BrianHoard is offline Need help with a script with Selection and If for Font Size &lt; 8? Windows 10 Need help with a script with Selection and If for Font Size &lt; 8? Office 2019
Advanced Beginner
 
Join Date: Jul 2022
Location: Haymarket, VA USA
Posts: 85
BrianHoard is on a distinguished road
Default

Hello, please see if this script works for you.
For testing, I also am highlighting the characters < 8.5 in yellow so you can see which ones were changed. Just comment that line out when you're ready.

A couple things that may also help that I've added:
- An undo record so this script can be undone in a single undo action.
- I'm storing the desiredFontSize at the top of the script as a variable, in case you need to change it in the future, it's easy to find.

Code:
Sub fontFixer()
  Dim docRange As Range
  Set docRange = ActiveDocument.Content
  
  Dim scriptName As String
  scriptName = "fontFixer"
  
  Dim desiredFontSize As Double
  desiredFontSize = 8.5
  
  Dim bhhUndo As UndoRecord
  
  Dim currentFontSize As Double
    
  Application.ScreenUpdating = False
    
  ' Begin undo record
  Set bhhUndo = Application.UndoRecord
  bhhUndo.StartCustomRecord (scriptName)
  
  ' Loop through each character
  For Each Char In docRange.Characters
    ' Get current font size
    currentFontSize = Char.Font.Size
    
    ' If currentFontSize < desiredFontSize, set it to desiredFontSize
    If currentFontSize < desiredFontSize Then
      Char.HighlightColorIndex = wdYellow ' Highlight the character in yellow
      Char.Font.Size = desiredFontSize
    End If
  Next Char
  
  bhhUndo.EndCustomRecord ' End undo
  Application.ScreenUpdating = True

End Sub
Attached Images
File Type: png snap.png (89.0 KB, 9 views)
Reply With Quote
  #3  
Old 06-04-2023, 07:57 PM
Cendrinne's Avatar
Cendrinne Cendrinne is offline Need help with a script with Selection and If for Font Size &lt; 8? Windows 10 Need help with a script with Selection and If for Font Size &lt; 8? Office 2019
Competent Performer
Need help with a script with Selection and If for Font Size &lt; 8?
 
Join Date: Aug 2019
Location: Montreal Quebec Canada
Posts: 190
Cendrinne is on a distinguished road
Default Hello, and thank you for you prompt reply, I got error message...

As is I got error message for ''Char'', since it said Not defined.

So I Dim it:
Code:
Dim Char As Characters
Then I got another message for Font on this line:
Code:
currentFontSize = Char.Font.Size
Well, I've copied it that row and past it under, while puting the first row not active.
If you back it up to remove ''.Font.Size'', then put a dot, it's true, it won't give you the previous choices.
ie:
Code:
   'currentFontSize = Char.Font.Size
    currentFontSize = Char.
But it was a good effort. Let's see if we can try to find something together

Thanks so much for trying

******By the way, I have Option Explicit, on top of the module, if that could explain the reason I get error message.

C
Reply With Quote
  #4  
Old 06-04-2023, 08:25 PM
Cendrinne's Avatar
Cendrinne Cendrinne is offline Need help with a script with Selection and If for Font Size &lt; 8? Windows 10 Need help with a script with Selection and If for Font Size &lt; 8? Office 2019
Competent Performer
Need help with a script with Selection and If for Font Size &lt; 8?
 
Join Date: Aug 2019
Location: Montreal Quebec Canada
Posts: 190
Cendrinne is on a distinguished road
Default

Cause I have a freaking long script, that works, but I keep trying to shorten it

Code:
Sub FNR_IF_Font_is_below_8p5_put_Font_to_8p5()
'
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 1
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 1.5
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
         .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
         .Size = 2
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
         .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 2.5
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 3
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 3.5
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 4
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 4.5
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 5
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 5.5
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 6
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 6.5
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 7
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 7.5
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Size = 8
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 8.5

    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub
It's long, but at least, worst case scenario, I could use this.

But I'm sure there must be a better solution.

C
Reply With Quote
  #5  
Old 06-04-2023, 08:48 PM
Cendrinne's Avatar
Cendrinne Cendrinne is offline Need help with a script with Selection and If for Font Size &lt; 8? Windows 10 Need help with a script with Selection and If for Font Size &lt; 8? Office 2019
Competent Performer
Need help with a script with Selection and If for Font Size &lt; 8?
 
Join Date: Aug 2019
Location: Montreal Quebec Canada
Posts: 190
Cendrinne is on a distinguished road
Default

Found someting here

Code:
Sub CommentMania()
'found here in forum :https://www.msofficeforums.com/word-vba/38890-macro-font-names-sizes.html
'done by Guessed / Andrew Lockton 2018-06-13 at 9:00 am

  Dim aRng As Range, aPara As Paragraph
  Set aRng = ActiveDocument.Range

  For Each aPara In aRng.Paragraphs
      If aPara.Range.Font.Size < 7 Then
'          aPara.Range.Font.Name <> "Arial"
          aPara.Range.Font.Size = 8.5
      End If

  Next aPara
End Sub

it doesn't highlight, but maybe we can figure it out, but at least it's shorther

Note: with the single quote, I've just deactivated the original script. I often leave them in in case I need to tweek it for testing.
but later on, I remove them. ***I've just removed most of them to not confuse anyone

C
Reply With Quote
  #6  
Old 06-04-2023, 09:07 PM
Cendrinne's Avatar
Cendrinne Cendrinne is offline Need help with a script with Selection and If for Font Size &lt; 8? Windows 10 Need help with a script with Selection and If for Font Size &lt; 8? Office 2019
Competent Performer
Need help with a script with Selection and If for Font Size &lt; 8?
 
Join Date: Aug 2019
Location: Montreal Quebec Canada
Posts: 190
Cendrinne is on a distinguished road
Default

Here is with variants (Find & Replace) and color Teal the font change, here is the scripts :

Code:
Sub FNR_Font_Mod_ONLY_size_Variant_from_xx_to_xx_with_Colr()
'Works 2023-06-05
'CommentMania, original script name
'found here in forum :https://www.msofficeforums.com/word-vba/38890-macro-font-names-sizes.html
'done by Guessed / Andrew Lockton 2018-06-13 at 9:00 am  // modified by me 2023-06-05

  Dim aRng As Range, aPara As Paragraph
  Dim sVar1 As Variant                'Font Size IF below
  Dim sVar2 As Variant                'Font Size TO change if found
  
  Set aRng = ActiveDocument.Range

    sVar1 = InputBox("Enter the size of the Font to Search for IF below a certain size." _
     & vbCr & "This includes half points. Example : 7.5", "SUGGESTION", "7.5")                                      'For ENG, it's a period vs comma for FRE 7.5 ENG / 7,5 FRE

    sVar2 = InputBox("Enter the desired Font Size, replacing the prior variable, if below...." _
     & vbCr & "This includes half points. Example : 9 ou 8.5", "SUGGESTION", "8.5")                                 'For ENG, it's a period vs comma for FRE 7.5 ENG / 7,5 FRE

  For Each aPara In aRng.Paragraphs
  
     'If aPara.Range.Font.Size < 7 Then
      If aPara.Range.Font.Size <= sVar1 Then
          
'          aPara.Range.Font.Name <> "Arial"
          aPara.Range.Font.Size = sVar2
          aPara.Range.Font.ColorIndex = wdTeal
      End If

  Next aPara

End Sub
Works, again, I didn't search yet for the HighLight, but I'll try it now.

Let me know if it works on your side too

C

Last edited by Cendrinne; 06-04-2023 at 11:09 PM. Reason: Modified to show Search for below or equal font size
Reply With Quote
  #7  
Old 06-04-2023, 09:20 PM
Cendrinne's Avatar
Cendrinne Cendrinne is offline Need help with a script with Selection and If for Font Size &lt; 8? Windows 10 Need help with a script with Selection and If for Font Size &lt; 8? Office 2019
Competent Performer
Need help with a script with Selection and If for Font Size &lt; 8?
 
Join Date: Aug 2019
Location: Montreal Quebec Canada
Posts: 190
Cendrinne is on a distinguished road
Default

If we want to Highlight and color Teal the font change, here is the scripts:

Code:
Sub FNR_Font_Mod_ONLY_size_Variant_from_xx_to_xx_with_HighLight_Colr()
'Works 2023-06-05
'CommentMania, original script name
'found here in forum :https://www.msofficeforums.com/word-vba/38890-macro-font-names-sizes.html
'done by Guessed / Andrew Lockton 2018-06-13 at 9:00 am  // modified by me 2023-06-05

  Dim aRng As Range, aPara As Paragraph
  Dim sVar1 As Variant                'Font Size IF below
  Dim sVar2 As Variant                'Font Size TO change if found
  
  Set aRng = ActiveDocument.Range

    sVar1 = InputBox("Enter the size of the Font to Search for IF below a certain size." _
     & vbCr & "This includes half points. Example : 7.5", "SUGGESTION", "7.5")                                      'For ENG, it's a period vs comma for FRE 7.5 ENG / 7,5 FRE

    sVar2 = InputBox("Enter the desired Font Size, replacing the prior variable, if below...." _
     & vbCr & "This includes half points. Example : 9 ou 8.5", "SUGGESTION", "8.5")                                 'For ENG, it's a period vs comma for FRE 7.5 ENG / 7,5 FRE

  For Each aPara In aRng.Paragraphs
  
     'If aPara.Range.Font.Size < 7 Then
      If aPara.Range.Font.Size <= sVar1 Then
          
          Options.DefaultHighlightColorIndex = wdYellow
'          aPara.Range.Font.Name <> "Arial"
          aPara.Range.Font.Size = sVar2
          aPara.Range.HighlightColorIndex = wdYellow
          aPara.Range.Font.ColorIndex = wdTeal
      End If

  Next aPara

End Sub
So this is it.

It is found and perfected, well much better than it was.

I thank you for your input and suggesting the idea of highlighting the change

C

Last edited by Cendrinne; 06-04-2023 at 11:07 PM. Reason: I've modified the script to show below and equal to sVar1
Reply With Quote
  #8  
Old 06-04-2023, 10:15 PM
Cendrinne's Avatar
Cendrinne Cendrinne is offline Need help with a script with Selection and If for Font Size &lt; 8? Windows 10 Need help with a script with Selection and If for Font Size &lt; 8? Office 2019
Competent Performer
Need help with a script with Selection and If for Font Size &lt; 8?
 
Join Date: Aug 2019
Location: Montreal Quebec Canada
Posts: 190
Cendrinne is on a distinguished road
Default

Fixed the scripts

Test this out.
Copy the below, and put the font size as the number prior to text.
Then copy the script and ask to change any font size of ''8 and below'', then run the script, It should color and highlight, everything except for the size 8.5 (since you will ask to find size 8 and below).

7
Sub FNR_SI_Format_Police_sous_Grosseur_7_met_grosseur_ 8p5_avec_variable()
'Works 2023-06-05
'CommentMania, original script name
'found here in forum :https://www.msofficeforums.com/word-...mes-sizes.html
'done by Guessed / Andrew Lockton 2018-06-13 at 9:00 am // modified by me 2023-06-05


7.5
Dim aRng As Range, aPara As Paragraph
Dim sVar1 As Variant 'Font Size IF below
Dim sVar2 As Variant 'Font Size TO change if found
Set aRng = ActiveDocument.Range


6.5
sVar1 = InputBox("Entre la grosseur de la police recherché si en bas de la grosseur désirée." _
& vbCr & "Pour des demi-points, met une virgule. Exemple : 7,5", "SUGGESTION", "7,5") 'pour les anglais, c'est point vs virgule 7.5 ENG / 7,5 FRE

sVar2 = InputBox("Entre la grosseur de la police à remplacé si trouvé en bas de...." _
& vbCr & "Pour des demi-points, met une virgule. Exemple : 9 ou 8,5", "SUGGESTION", "8,5") 'pour les anglais, c'est point vs virgule 8.5 ENG / 8,5 FRE


8.5
For Each aPara In aRng.Paragraphs

If aPara.Range.Font.Size <= sVar1 Then

Options.DefaultHighlightColorIndex = wdYellow


8
aPara.Range.Font.Size = sVar2
aPara.Range.HighlightColorIndex = wdYellow
aPara.Range.Font.ColorIndex = wdTeal
End If

Next aPara

End Sub

Let me know how it turns out for others

C
Reply With Quote
Reply

Tags
code, font macro, help please

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Need help with a script with Selection and If for Font Size &lt; 8? VBA - Word how to globally change the font and font size in footnotes thomasoj Word VBA 3 01-15-2020 06:26 AM
Need help with a script with Selection and If for Font Size &lt; 8? Merging two Word documents: 2nd document not maintaining original font type and font size Swarup Word 31 08-28-2018 06:55 PM
Word 10: need information typed to be in font of default selection instead of Template Font 1SickPuppy Word 1 05-06-2017 03:00 PM
Font size showing different (some superscripted??) but tools show its the same size? mikkygee PowerPoint 4 12-14-2015 11:21 PM
Need help with a script with Selection and If for Font Size &lt; 8? Looping Macro to Change Font, Font Size, and Give Heading 1 WH7262 Word VBA 1 08-26-2014 03:46 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 05:12 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2023, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2023 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft