|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Trouble converting a sub to function, incl. passing argument and nixing Selection
I'm trying to convert a macro to a function. The macro converts user-selected text to title case. I want the function to convert a string variable instead. I'm struggling to figure out how passing a string - as a range - to the function, and how to convert the function's Selection elements to Range elements. First, should I even be passing a range? And if so, how do I first convert a string variable to a range? The super-crude approach below works, but is ugly -- it's because I haven't been able to figure out how to instantiate the range and assign it text at the same time: Code:
Sub Test_PassToFunction() Dim rngTitle As Range Set rngTitle = ActiveDocument.Words(1) rngTitle.Text = "SECTION 00 00 00 - THIS IS THE TITLE OF THE SECTION" ' (The string is actually a variable coming from another macro.) fcnTitleCase (rngTitle) End Sub Code:
Function fcnTitleCase(rngTitle) ' From Allen Wyatt ' https://word.tips.net/T000215_Intelligent_Title_Case.html Dim lclist As String Dim wrd As Integer Dim sTest As String ' list of lowercase words, surrounded by spaces lclist = " of the by to this is from a " Selection.Range.Case = wdTitleWord For wrd = 2 To Selection.Range.Words.Count sTest = Trim(Selection.Range.Words(wrd)) sTest = " " & LCase(sTest) & " " If InStr(lclist, sTest) Then Selection.Range.Words(wrd).Case = wdLowerCase End If Next wrd End Function |
#2
|
||||
|
||||
Range and String are two different data types. There is no point in passing a string to the function since the .Case won't work on a string but it does work on a range.
Functions differ from Subs in that they usually return a value - that isn't necessary in this case as we are passing a range and the function is changing the value of the text in the range. Code:
Sub Test_PassToFunction() Dim rngTitle As Range Set rngTitle = ActiveDocument.Words(1) rngTitle.Text = "SECTION 00 00 00 - THIS IS THE TITLE OF THE SECTION" ' (The string actually a variable coming from another macro.) MakeTitleCase rngTitle End Sub Sub MakeTitleCase (rng As Range) ' Modified from Allen Wyatt https://word.tips.net/T000215_Intelligent_Title_Case.html Dim lclist As String, iWord As Integer, sTest As String lclist = " of the by to this is from a " ' List of lowercase words, surrounded by spaces rng.Case = wdTitleWord ' Make Camel Case For iWord = 2 To rng.Words.Count sTest = " " & LCase(Trim(rng.Words(iWord))) & " " If InStr(lclist, sTest) Then rng.Words(iWord).Case = wdLowerCase End If Next iWord End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
Thanks for your help and explanation, Andrew. I'm afraid I've failed to describe just what I'm trying to achieve.
The overall objective is to:
Code:
Set rngTitle = ActiveDocument.Words(1) Code:
Set rngTitle.Text = "SECTION 00 00 00, ETC." Thanks again. |
#4
|
||||
|
||||
What I think you require here is to convert a title that is at the start of a document from upper case to true title case e.g.
Code:
Option Explicit Sub FormatTitle() Const sList As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 -" Dim rngTitle As Range Set rngTitle = ActiveDocument.Range rngTitle.Collapse 1 rngTitle.MoveEndWhile sList TrueTitleCase rngTitle End Sub Sub TrueTitleCase(oRng As Range) Dim vFindText As Variant Dim vReplText As Variant Dim i As Long Dim k As Long Dim m As Long 'count the characters in the selected string k = Len(oRng) If k < 1 Then 'If none, then the range is empty 'so warn the user MsgBox "The range has no text!", vbOKOnly, "No text selected" Exit Sub 'and quit the macro End If 'format the selected string as title case oRng.Case = wdTitleWord 'list the exceptions to look for in an array vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _ "If", "In", "Of", "On", "Or", "The", "To", "With") 'list their replacements in a matching array vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _ "if", "in", "of", "on", "or", "the", "to", "with") With oRng With .Find 'replace items in the first list 'with the corresponding items from the second .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Format = True .MatchCase = True For i = LBound(vFindText) To UBound(vFindText) .Text = vFindText(i) .Replacement.Text = vReplText(i) .Execute Replace:=wdReplaceAll Next i End With 'Reduce the range of the selected text 'to encompass only the first character .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1 'format that character as upper case .Case = wdUpperCase 'restore the selected text to its original length .MoveEnd Unit:=wdCharacter, Count:=k 'and check to see if the string contains a colon If InStr(1, oRng, ":") > 0 Then 'If it does note the position of the character 'after the first colon m = InStr(1, oRng, ":") + 1 'and set that as the new start of the selected text .MoveStart wdCharacter, m 'set the end of the selected text to include 'one extra character .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1 'format that character as upper case .Case = wdUpperCase End If End With lbl_Exit: Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
||||
|
||||
On reflection, if the title in question is the whole of the first paragraph you can use
the following to call the sub. Code:
Sub FormatTitle() TrueTitleCase ActiveDocument.Paragraphs(1).Range End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#6
|
|||
|
|||
Thanks for taking the time to provide some code. Unfortunately, I actually need to leave the cap'd text as-is (and, in fact, it's not always going to be all cap'd).
What I need to do is take the text and do stuff with it elsewhere: populate document properties and create a list in another document. It needs to be camel case per our style guide and bookmarking requirements (as the doc properties will import into PDFs doc properties). Here's the relevant code. My struggle is figuring out how to get an all-cap'd string to another macro or function and converted to camel case. Code:
Sub LoopAllWordFilesInFolder() Dim docDocument As Document Dim strPath As String Dim strFile As String Dim strExtension As String Dim FolderPicker As FileDialog Application.ScreenUpdating = False ' Get target folder path from user: Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker) With FolderPicker .Title = "Choose the folder containing your files" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode strPath = .SelectedItems(1) & "\" End With ' In case the user cancels: NextCode: strPath = strPath If strPath = "" Then GoTo ResetSettings ' To run the macro on .DOCX files only, change "*.doc*" to "*.docx" ' To run the macro on .DOC files only, change "*.doc*" to "*.doc" strExtension = "*.doc*" ' Target path with file extension: strFile = Dir(strPath & strExtension) ' Loop through each file in the folder: Do While strFile <> "" ' Set variable equal to opened document: Set docDocument = Documents.Open(FileName:=strPath & strFile) ' Use DoEvents to ensure document has opened before moving on to next line of code. DoEvents ' CALL OTHER MACROS HERE: Call Specs_GetNameAndNumber ' Save and close document: If docDocument.Saved = False Then docDocument.Save docDocument.Close ' Ensure document has closed before moving on to next line of code: DoEvents ' Get next file name: strFile = Dir Loop MsgBox "The macro has looped through the files in the folder you chose and completed the tasks." ' Reset macro optimization settings: ResetSettings: Application.ScreenUpdating = True End Sub Sub Specs_GetNameAndNumber() ' 08/19/2021 ' This macro speeds up PDFing spec packages by setting the Author and Title ' properties in Word so that they don't have to be manually set in Acrobat, ' and it creates a rough ToC (using the spec template), if needed. ' The macro does the following: ' 1. Gets spec section number, presumed to be the first or second line of a ' document; however, the macro will loop through the initial paragraphs and ' skip blank ones (doesn't matter if name/numbers are in content controls) ' 2. Gets spec section name, presumed to be after section number; again, ' the macro skips blank lines ' 3. Removes hard and soft returns and tabs that end up in the the name/number ' variables and trims spaces from the beginning/end of each ' 4. Concatenates the two lines into a single string, i.e., the title ' 5. Changes the string to camel case, if necessary, per in-house style and ' bookmarking reqs. ' 6. Populates file document properties: ' - Title ' - Author (set to "Company Name") ' 7. If needed, creates a rough ToC based on spec template and applies formatting Dim strSectionNumber As String Dim strSectionName As String Dim strTitle As String Dim i As Long ' Counter to loop through first paragraphs in the section Dim k As Long ' To remove hard and soft returns and tabs from strings ' Loop through the first paragraphs until the section name -- the second ' variable -- is assigned: i = 1 Do Until strSectionName <> "" ' If the paragraph is empty (i.e., has a char. length of 1 [which is for ' the pilchrow]), then skip the paragraph: If ActiveDocument.Paragraphs(i).Range.Characters.Count = 1 Then i = i + 1 ' Otherwise, if section number or name variable hasn't been assigned, do it: Else If strSectionNumber = "" Then strSectionNumber = ActiveDocument.Paragraphs(i).Range.Text ' Increment counter to next paragraph: i = i + 1 ' If the section number variable has been assigned, then assign the ' section name variable: ElseIf strSectionName = "" Then strSectionName = ActiveDocument.Paragraphs(i).Range.Text ' Debug.Print strSectionName End If End If Loop ' Clean up and concatenate the strings to create the title: ' a. Remove tabs, paragraph marks, and soft returns, which are ' Chr(9), Chr(11), and Chr(13), respectively: For k = 9 To 13 Step 2 strSectionNumber = Replace(strSectionNumber, Chr(k), "") strSectionName = Replace(strSectionName, Chr(k), "") Next k ' b. Trim spaces from both ends of the strings: strSectionNumber = Trim(strSectionNumber) strSectionName = Trim(strSectionName) ' c. Concatenate the number and name and assign to a variable: strTitle = strSectionNumber & " - " & strSectionName Debug.Print strTitle ' Change to camel case: ' ????????????????? ' Populate the file's document properties: Call DocProperties_SetInFile(strTitle) ' Create rough ToC (pending): ''Call ExtractListOfSectionsToNewDoc End Sub Thank you |
#7
|
||||
|
||||
I would convert the source range to Camel Case and then use localised font formatting to make it appear as Upper Case. That way you always have the option to go back to Camel Case.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Having trouble creating a multiple selection drop down list, even after checking other threads | sbelinski | Word VBA | 1 | 12-14-2020 03:33 PM |
Help wanted passing data to Form | kirkm | Word VBA | 4 | 09-19-2016 07:03 PM |
trouble with pdf doc after converting to word.. | tom356 | Word | 3 | 09-11-2016 08:23 AM |
passing variable from one sub to another | gbrew584 | Excel Programming | 10 | 03-21-2016 12:06 AM |
userform help (having trouble passing info from form to macro) | cyraxote | Word VBA | 16 | 09-08-2015 04:16 AM |