Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 08-17-2021, 11:59 PM
Peterson Peterson is offline Trouble converting a sub to function, incl. passing argument and nixing Selection Windows 10 Trouble converting a sub to function, incl. passing argument and nixing Selection Office 2019
Competent Performer
Trouble converting a sub to function, incl. passing argument and nixing Selection
 
Join Date: Jan 2017
Posts: 141
Peterson is on a distinguished road
Default 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
Meanwhile, I want the function to convert the string without Selection. Ample searching and multiple attempts have only yielded as many error messages. Here's the code:
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
Thank you
Reply With Quote
  #2  
Old 08-18-2021, 01:16 AM
Guessed's Avatar
Guessed Guessed is offline Trouble converting a sub to function, incl. passing argument and nixing Selection Windows 10 Trouble converting a sub to function, incl. passing argument and nixing Selection Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

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
Reply With Quote
  #3  
Old 08-18-2021, 09:16 PM
Peterson Peterson is offline Trouble converting a sub to function, incl. passing argument and nixing Selection Windows 10 Trouble converting a sub to function, incl. passing argument and nixing Selection Office 2019
Competent Performer
Trouble converting a sub to function, incl. passing argument and nixing Selection
 
Join Date: Jan 2017
Posts: 141
Peterson is on a distinguished road
Default

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:
  1. Extract capitalized text from the beginning of a document
  2. Pass the text to a function that converts it to camel case
  3. Pass the camel-case text back and do other stuff
In my code yesterday, I included the following line to set the range:
Code:
Set rngTitle = ActiveDocument.Words(1)
I actually don't want the first word in the document to be the range. I only used this code because I can't otherwise figure out how to convert the all-cap'd text to a range, which I assume is necessary in order to run the text through the MakeTitleCase code, as there's no user-selected text, so Selection can't be used. Among other attempts, I tried the following, which doesn't work:
Code:
Set rngTitle.Text = "SECTION 00 00 00, ETC."
I think I'm misunderstanding the range concept; that is, perhaps a range can apply only to some portion of a document?? I'm stuck on it because I don't know how else to get around the Selection issue. Or maybe I need to do this differently, by parsing the entire string, evaluating each word on its own, then re-assembling?? In other words, Allen's macro really only works for user-selected text and trying to convert it to work on a range won't work, in this case (sorry, bad pun).

Thanks again.
Reply With Quote
  #4  
Old 08-18-2021, 11:29 PM
gmayor's Avatar
gmayor gmayor is offline Trouble converting a sub to function, incl. passing argument and nixing Selection Windows 10 Trouble converting a sub to function, incl. passing argument and nixing Selection Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
Reply With Quote
  #5  
Old 08-18-2021, 11:53 PM
gmayor's Avatar
gmayor gmayor is offline Trouble converting a sub to function, incl. passing argument and nixing Selection Windows 10 Trouble converting a sub to function, incl. passing argument and nixing Selection Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
Reply With Quote
  #6  
Old 08-19-2021, 06:51 PM
Peterson Peterson is offline Trouble converting a sub to function, incl. passing argument and nixing Selection Windows 10 Trouble converting a sub to function, incl. passing argument and nixing Selection Office 2019
Competent Performer
Trouble converting a sub to function, incl. passing argument and nixing Selection
 
Join Date: Jan 2017
Posts: 141
Peterson is on a distinguished road
Default

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
Reply With Quote
  #7  
Old 08-19-2021, 07:58 PM
Guessed's Avatar
Guessed Guessed is offline Trouble converting a sub to function, incl. passing argument and nixing Selection Windows 10 Trouble converting a sub to function, incl. passing argument and nixing Selection Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

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
Reply With Quote
Reply

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
Trouble converting a sub to function, incl. passing argument and nixing Selection Help wanted passing data to Form kirkm Word VBA 4 09-19-2016 07:03 PM
Trouble converting a sub to function, incl. passing argument and nixing Selection trouble with pdf doc after converting to word.. tom356 Word 3 09-11-2016 08:23 AM
Trouble converting a sub to function, incl. passing argument and nixing Selection passing variable from one sub to another gbrew584 Excel Programming 10 03-21-2016 12:06 AM
Trouble converting a sub to function, incl. passing argument and nixing Selection userform help (having trouble passing info from form to macro) cyraxote Word VBA 16 09-08-2015 04:16 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 10:33 AM.


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