View Single Post
 
Old 03-28-2018, 10:35 AM
slaycock slaycock is offline Windows 7 64bit Office 2016
Expert
 
Join Date: Sep 2013
Posts: 255
slaycock is on a distinguished road
Default

Try the following

1. Ceate an excel workbook where column a of the first worksheet contains the words you want in lower case

2. Run the macro convert_excel_list_to_lower_case

3. Use the filepicker to select your excel file.

The macro assumes that you are only changing the case of the words as stated in your initial post. If you want to change words then a minor adaption will allow this to be done.

Code:
Option Explicit

Sub convert_excel_list_to_lower_case()


Dim xlApp                       As Excel.Application
Dim xlWB                        As Excel.Workbook
Dim xlWS                        As Excel.Worksheet
Dim wb_path                     As String
Dim index                       As Long
Dim find_range                  As Word.Range
Dim find_strings()              As Variant


    Set xlApp = New Excel.Application
    wb_path = get_workbook
    If wb_path = vbNullString Then
       Exit Sub
    End If
    
    Set xlWB = xlApp.Workbooks.Open(wb_path)
    Set xlWS = xlWB.Worksheets(1)
    
    find_strings = xlWS.Application.WorksheetFunction.Transpose(xlWS.Range("A1", xlWS.Cells(xlWS.Range("A1").End(xlDown).row, 1)))
    For index = LBound(find_strings, 1) To UBound(find_strings, 1)
        Set find_range = ActiveDocument.StoryRanges(wdMainTextStory)
        With find_range.find
            .ClearFormatting
            .Wrap = wdFindStop
            .Forward = True
            .Format = True
            .MatchCase = False
            .MatchWildcards = False
            .text = find_strings(index)
            .Execute
            Do Until Not .Found
                If InStr(find_range.Style, "Heading") = 0 Then
                    find_range.Case = wdLowerCase
                    find_range.Case = wdTitleSentence
                End If
                .Execute
            Loop
        End With
    Next

    set xlWS = nothing
    set xlWB = nothing
    set xlApp = nothing
End Sub

Function get_workbook() As String
Dim file_picker                             As FileDialog
Const first_picked_file                     As Long = 1


    Set file_picker = Application.FileDialog(msoFileDialogFilePicker)
    With file_picker
        .Title = "Select Workbook"
        .InitialFileName = ActiveDocument.Path
        
        If .Show = vbCancel Then
            get_workbook = vbNullString
        Else
            If InStr(.SelectedItems(first_picked_file), ".xlsx") = 0 Then
                get_workbook = vbNullString
                MsgBox "Oops. That file wasn't a workbook", vbOKOnly
            Else
                get_workbook = .SelectedItems(first_picked_file)
            End If
        End If
    End With
    
End Function
Reply With Quote