#1
|
|||
|
|||
Macro clean-up help,please
I am no coder. I recorded this macro and am certain it could be simpler. Help, please?
Sub SmartQuotesToStraight() ' ' Changes Smart Quotes to Straight. Entire document. ' Code:
With Options .AutoFormatAsYouTypeApplyHeadings = False .AutoFormatAsYouTypeApplyBorders = False .AutoFormatAsYouTypeApplyBulletedLists = False .AutoFormatAsYouTypeApplyNumberedLists = False .AutoFormatAsYouTypeApplyTables = False .AutoFormatAsYouTypeReplaceQuotes = False .AutoFormatAsYouTypeReplaceSymbols = False .AutoFormatAsYouTypeReplaceOrdinals = True .AutoFormatAsYouTypeReplaceFractions = True .AutoFormatAsYouTypeReplacePlainTextEmphasis = False .AutoFormatAsYouTypeReplaceHyperlinks = True .AutoFormatAsYouTypeFormatListItemBeginning = False .AutoFormatAsYouTypeDefineStyles = False .TabIndentKey = False End With With AutoCorrect .CorrectInitialCaps = True .CorrectSentenceCaps = True .CorrectDays = True .CorrectCapsLock = True .ReplaceText = True .ReplaceTextFromSpellingChecker = True .CorrectKeyboardSetting = False .DisplayAutoCorrectOptions = True .CorrectTableCells = True End With With Options .AutoFormatApplyHeadings = False .AutoFormatApplyLists = False .AutoFormatApplyBulletedLists = False .AutoFormatApplyOtherParas = False .AutoFormatReplaceQuotes = True .AutoFormatReplaceSymbols = False .AutoFormatReplaceOrdinals = True .AutoFormatReplaceFractions = True .AutoFormatReplacePlainTextEmphasis = True .AutoFormatReplaceHyperlinks = True .AutoFormatPreserveStyles = True .AutoFormatPlainTextWordMail = True End With Options.LabelSmartTags = False Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = """" .Replacement.Text = """" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "'" .Replacement.Text = "'" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Options .AutoFormatAsYouTypeApplyHeadings = False .AutoFormatAsYouTypeApplyBorders = False .AutoFormatAsYouTypeApplyBulletedLists = False .AutoFormatAsYouTypeApplyNumberedLists = False .AutoFormatAsYouTypeApplyTables = False .AutoFormatAsYouTypeReplaceQuotes = True .AutoFormatAsYouTypeReplaceSymbols = False .AutoFormatAsYouTypeReplaceOrdinals = True .AutoFormatAsYouTypeReplaceFractions = True .AutoFormatAsYouTypeReplacePlainTextEmphasis = False .AutoFormatAsYouTypeReplaceHyperlinks = True .AutoFormatAsYouTypeFormatListItemBeginning = False .AutoFormatAsYouTypeDefineStyles = False .TabIndentKey = False End With With AutoCorrect .CorrectInitialCaps = True .CorrectSentenceCaps = True .CorrectDays = True .CorrectCapsLock = True .ReplaceText = True .ReplaceTextFromSpellingChecker = True .CorrectKeyboardSetting = False .DisplayAutoCorrectOptions = True .CorrectTableCells = True End With With Options .AutoFormatApplyHeadings = False .AutoFormatApplyLists = False .AutoFormatApplyBulletedLists = False .AutoFormatApplyOtherParas = False .AutoFormatReplaceQuotes = True .AutoFormatReplaceSymbols = False .AutoFormatReplaceOrdinals = True .AutoFormatReplaceFractions = True .AutoFormatReplacePlainTextEmphasis = True .AutoFormatReplaceHyperlinks = True .AutoFormatPreserveStyles = True .AutoFormatPlainTextWordMail = True End With Options.LabelSmartTags = False End Sub |
#2
|
|||
|
|||
I use this:
Code:
Sub ConvertQuoteFormat() Dim rngstory As Word.Range Dim pAction As String Dim bSQSetting As Boolean 'Stores users AutoCorrect "smart quote" options. True if enabled bSQSetting = Options.AutoFormatAsYouTypeReplaceQuotes pAction = InputBox("Enter ""1"" to convert ""straight quotes"" to ""smart quotes.""" _ & vbCr + vbCr & "Enter ""2"" to convert ""smart quotes"" to ""straight quotes.""", _ "Action", "1") If pAction = "1" Then 'Convert to curly Options.AutoFormatAsYouTypeReplaceQuotes = True For Each rngstory In ActiveDocument.StoryRanges Do If rngstory.StoryLength >= 2 Then CurlyQuoteToggle rngstory End If Set rngstory = rngstory.NextStoryRange Loop Until rngstory Is Nothing Next If bSQSetting = False Then If MsgBox("Do you want to format new text entered in this document using ""smart qoutes?""", vbQuestion + vbYesNo, "AutoFormat") = vbYes Then Options.AutoFormatAsYouTypeReplaceQuotes = True bSQSetting = Options.AutoFormatAsYouTypeReplaceQuotes End If End If Else 'Convert to straight Options.AutoFormatAsYouTypeReplaceQuotes = False For Each rngstory In ActiveDocument.StoryRanges Do If rngstory.StoryLength >= 2 Then CurlyQuoteToggle rngstory End If Set rngstory = rngstory.NextStoryRange Loop Until rngstory Is Nothing Next If bSQSetting = True Then If MsgBox("Do you want to format new text entered in this document using ""straight qoutes?""", vbQuestion + vbYesNo, "AutoFormat") = vbYes Then Options.AutoFormatAsYouTypeReplaceQuotes = False bSQSetting = Options.AutoFormatAsYouTypeReplaceQuotes End If End If End If Options.AutoFormatAsYouTypeReplaceQuotes = bSQSetting lbl_Exit: Exit Sub End Sub Sub CurlyQuoteToggle(ByVal rngstory As Word.Range) With rngstory.Find 'quote marks .Text = Chr$(34) .Replacement.Text = Chr$(34) .Execute Replace:=wdReplaceAll 'apostrophe .Text = Chr$(39) .Replacement.Text = Chr$(39) .Execute Replace:=wdReplaceAll End With End Sub |
#3
|
|||
|
|||
Thanks, Greg. I was thinking that all the "auto format as you type" lines were probably unnecessary. In any case, both macros work.
|
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to clean instal office 2019? | hatnel | Office | 6 | 04-15-2020 02:22 AM |
Office support saying my network is not clean | Cassera | Office | 1 | 09-29-2013 10:43 PM |
Any easy way to clean up bulleted list? | New Daddy | Word | 2 | 08-29-2013 06:00 AM |
Need help on how to clean up my macro | Peter Carter | Word VBA | 4 | 08-28-2013 11:32 AM |
Clean an Email backup file | TTN | Office | 22 | 07-14-2012 01:48 AM |