Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-27-2018, 10:10 PM
GuitarForLife GuitarForLife is offline Move Selection to the next Column on a Page (Not a table) Windows 10 Move Selection to the next Column on a Page (Not a table) Office 2016
Novice
Move Selection to the next Column on a Page (Not a table)
 
Join Date: Jan 2018
Location: Adelaide South Australia
Posts: 3
GuitarForLife is on a distinguished road
Default Move Selection to the next Column on a Page (Not a table)

Hi, Ive written some code which changes the colour of certain selected text.
The page of each document has either one or two columns. The documents are only one page long.
The code works beautifully as it moves down the first column of text, but wont move up to the top of the second column to start editing that piece of text.
I cant find any code that identifies the number of columns, and then moves the selection from the bottom of the first column (when it gets there), to the top of the second column so it can start the process again.

Appreciate your help!

Here is my code:

Sub ColourText()
Dim numOfLines As Integer
Dim numOfColumns As Integer
Dim numOfSpaces As Integer
Dim numOfChar As Integer
Dim ArraySpaces() As String
Dim x1 As Integer


'Count the number of non blank lines in current document
numOfLines = ActiveDocument.BuiltInDocumentProperties("NUMBER OF LINES")


'Move to start of document
Selection.HomeKey Unit:=wdStory

'Start the loop - looping once for each line
For x1 = 1 To numOfLines

'Move to start of line
Selection.HomeKey Unit:=wdLine

'Select entire line
Selection.EndKey Unit:=wdLine, Extend:=wdExtend


If Len(Selection.Range.Text) > 1 Then 'if 1 ignore as paragraph return only

'check to see if current line is likely to be Chords - ie if it contains lots of spaces
ArraySpaces = Split(Selection.Range.Text, " ")


numOfSpaces = UBound(ArraySpaces)

'count characters in selection
numOfChar = Len(Selection.Range.Text) - numOfSpaces

If (numOfSpaces > numOfChar) Or numOfChar < 4 Then ' likely not to be text so should be chords
'colour this line blue
Selection.Font.TextColor.RGB = RGB(0, 0, 255)
Else 'colour this line black
Selection.Font.TextColor.RGB = RGB(0, 0, 0)
End If
End If

If InStr(1, Selection.Range.Text, "Chorus") Then
Selection.Range.HighlightColorIndex = wdYellow
Selection.Font.Bold = True
End If

'Move to the next part of the loop ##but wont do this when more than 1 column of text

Selection.MoveDown Unit:=wdLine, count:=1

Next x1

MsgBox ("Setup completed")

End Sub
Reply With Quote
  #2  
Old 01-28-2018, 12:04 AM
gmayor's Avatar
gmayor gmayor is offline Move Selection to the next Column on a Page (Not a table) Windows 10 Move Selection to the next Column on a Page (Not a table) Office 2016
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

'Lines' are a vague concept in Word, especially in a document that is dynamically formatted and doubly so when there are columns.

I won't pretend to know what your document looks like and so I can't test your macro to see what it does in practice, but as you have discovered, moving down by lines ignores the presence of a second column of text and continues to the next page. You need to move right to move the next column.

I suppose you could test whether the page has changed each time you move down and then move back and move right to the start of the next column (that will also take you to the start of the next page) e.g. as follows but whether it will work in the context of your macro is hard to ascertain

Code:
'Move to the next part of the loop ##but wont do this when more than 1 column of text
        iPage = Selection.Information(wdActiveEndPageNumber)
        Selection.MoveDown Unit:=wdLine, Count:=1
        If Selection.Information(wdActiveEndPageNumber) > iPage Then
            Selection.MoveUp Unit:=wdLine, Count:=1
            Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            Selection.MoveRight Unit:=wdCharacter
        End If
__________________
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
  #3  
Old 01-28-2018, 03:46 PM
GuitarForLife GuitarForLife is offline Move Selection to the next Column on a Page (Not a table) Windows 10 Move Selection to the next Column on a Page (Not a table) Office 2016
Novice
Move Selection to the next Column on a Page (Not a table)
 
Join Date: Jan 2018
Location: Adelaide South Australia
Posts: 3
GuitarForLife is on a distinguished road
Default Move Selection to the next Column on a Page (Not a table)

Thanks Graham. From your response I gather there is no way to tell what the bottom line of the first column is? I have included an example of a document if that helps further.

My numOfLines variable tells me the aggregate number of lines in both columns accurately, but I would prefer to use a loop that redirected to Selection.MoveRight Unit:=wdCharacter, once I hit the bottom of the first column.

Thanks
Attached Files
File Type: docx Martinez Melanie - Toxic.docx (15.3 KB, 27 views)
Reply With Quote
  #4  
Old 01-29-2018, 10:39 AM
kilroy kilroy is offline Move Selection to the next Column on a Page (Not a table) Windows 10 Move Selection to the next Column on a Page (Not a table) Office 2016
Competent Performer
 
Join Date: Sep 2016
Location: Southern Ontario
Posts: 118
kilroy is on a distinguished road
Default

Guitar, this is what I use for my sheet music. Not perfect but does a lot of the work. You can add more chords. I'm sure one of the guys could simplify it.

Code:
Sub ChangeColorTargets()
Dim range As range
Dim i As Long
Dim TargetList
 
TargetList = Array("A  ", "Am", "E7", "A#", "A7", "Ab", "B ", "Bm ", "B7", _
"C ", "Cm ", "D ", "Dm ", "E ", "Em ", " C", "C#", "Db", "D#", "E#", "Eb", "Fb", " F", "F#", "Gb", " G ", "G#", "Ab", "B#", "Bb")
'... Add additional words to this line at the end, each word to be separated with , "[WORD]"
' if you run out on the second line, end it with , "[WORD]" _ and continue on next line
 
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.Font.TextColor.RGB = RGB(0, 0, 255)
Loop
End With
Next
Call HighlightTargets
End Sub
Sub HighlightTargets()
Dim range As range
Dim i As Long
Dim TargetList
 
TargetList = Array("[Chorus]", "[Verse]", "[Bridge]", "[Solo]")
'... Add additional words to this line at the end, each word to be separated with , "[WORD]"
' if you run out on the second line, end it with , "[WORD]" _ and continue on next line
 
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow
Loop
End With
Next
 
End Sub
Reply With Quote
  #5  
Old 01-29-2018, 12:55 PM
GuitarForLife GuitarForLife is offline Move Selection to the next Column on a Page (Not a table) Windows 10 Move Selection to the next Column on a Page (Not a table) Office 2016
Novice
Move Selection to the next Column on a Page (Not a table)
 
Join Date: Jan 2018
Location: Adelaide South Australia
Posts: 3
GuitarForLife is on a distinguished road
Default

Hi Kilroy thanks for your thoughts- seems we have similar tastes! The problem for me is that I use every conceivable chord variation incl diminished, sus, half diminished, 6ths etc etc and therefore would be having potentially 100+ chord variations in the targetlist array. Instead of using that technique I've found that I can identify which line has chords, and which has lyrics through a ratio of spaces to total characters in the line. Works like a treat as I separate my chords with spaces. I'll try using your approach re setting range as this is where my code is going wrong as it won't find the second column.
Have you written any code for transposing? Love to see it if you have thanks?
Recently my computer crashed and I lost my 'tricky' code for transposing, and formatting, as the location for saving macros was not being backed up - very frustrating as all my docs etc are religiously backed up. Didn't realise they were kept in some obscure folder separate to the actual document.
Reply With Quote
  #6  
Old 01-30-2018, 06:29 AM
kilroy kilroy is offline Move Selection to the next Column on a Page (Not a table) Windows 10 Move Selection to the next Column on a Page (Not a table) Office 2016
Competent Performer
 
Join Date: Sep 2016
Location: Southern Ontario
Posts: 118
kilroy is on a distinguished road
Default

I thought about using spaces and the following code works for that but there are instances where even the lyric lines have many spaces at the start of the line like in the chorus the line "Yeah I love....". If you were to use tab and no more than 3 spaces to align lyrics with chords and use tabs for spacing the Title then the following works. Also keep in mind that the code looks for 4 spaces so when you have sections like "Solo" or "Bridge" where you only list the chords and don't need to align with lyrics those types of progressions need to have at least one place where you use 4 spaces in a row.

This is a temporary fix until you figure out the ratio thing, which is way above me. Looking forward to seeing the solution.

Also I'm very interested in the transposing code you spoke of.

Code:
Sub ChordFont()
    Dim oRng As range
    Set oRng = ActiveDocument.range
    With oRng.Find
        Do While .Execute(FindText:="    ")
            oRng.Start = oRng.Sentences(1).Start
            oRng.End = oRng.Paragraphs(1).range.End
            oRng.Font.TextColor.RGB = RGB(0, 0, 255)
            oRng.Collapse 0
        Loop
    End With
lbl_Exit:
    Set oRng = Nothing
 
      Call HighlightChorus
      Exit Sub
End Sub
Sub HighlightChorus()
    Dim oRng As range
    Set oRng = ActiveDocument.range
    With oRng.Find
        Do While .Execute(FindText:="[Chorus]")
            oRng.Start = oRng.Sentences(1).Start
            oRng.End = oRng.Paragraphs(1).range.End
            oRng.HighlightColorIndex = wdYellow
            oRng.Collapse 0
        Loop
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
 
End Sub
Reply With Quote
  #7  
Old 02-09-2018, 08:47 AM
kilroy kilroy is offline Move Selection to the next Column on a Page (Not a table) Windows 10 Move Selection to the next Column on a Page (Not a table) Office 2016
Competent Performer
 
Join Date: Sep 2016
Location: Southern Ontario
Posts: 118
kilroy is on a distinguished road
Default

Check this version out.

Code:
Sub ColourText2()
Dim numOfLines As Integer
Dim numOfColumns As Integer
Dim numOfSpaces As Integer
Dim numOfChar As Integer
Dim ArraySpaces() As String
Dim x1 As Integer
With Selection.PageSetup.TextColumns
        .SetCount NumColumns:=1
        .EvenlySpaced = True
        .LineBetween = False
End With

'Count the number of non blank lines in current document
numOfLines = ActiveDocument.BuiltInDocumentProperties("NUMBER OF LINES")

'Move to start of document
Selection.HomeKey Unit:=wdStory
Selection.WholeStory
'Start the loop - looping once for each line
For x1 = 1 To numOfLines
'Move to start of line
Selection.HomeKey Unit:=wdLine
'Select entire line
Selection.EndKey Unit:=wdLine, Extend:=wdExtend

If Len(Selection.Range.Text) > 1 Then 'if 1 ignore as paragraph return only
'check to see if current line is likely to be Chords - ie if it contains lots of spaces
ArraySpaces = Split(Selection.Range.Text, " ")
numOfSpaces = UBound(ArraySpaces)
'count characters in selection
numOfChar = Len(Selection.Range.Text) - numOfSpaces
If (numOfSpaces > numOfChar) Or numOfChar < 4 Then ' likely not to be text so should be chords
'colour this line blue
Selection.Font.TextColor.RGB = RGB(0, 0, 255)
Else 'colour this line black
Selection.Font.TextColor.RGB = RGB(0, 0, 0)
End If
End If
If InStr(1, Selection.Range.Text, "Chorus") Then
Selection.Range.HighlightColorIndex = wdYellow
Selection.Font.Bold = True
End If
'Move to the next part of the loop ##but wont do this when more than 1 column of text
Selection.MoveDown Unit:=wdLine, Count:=1
'Selection.Columns.Select
Next x1
With Selection.PageSetup.TextColumns
        .SetCount NumColumns:=2
        .EvenlySpaced = True
        .LineBetween = False
        .Width = InchesToPoints(3.49)
End With
MsgBox ("Setup completed. Rock on Bud!")
End Sub
Reply With Quote
  #8  
Old 02-09-2018, 01:59 PM
macropod's Avatar
macropod macropod is offline Move Selection to the next Column on a Page (Not a table) Windows 7 64bit Move Selection to the next Column on a Page (Not a table) Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

IMHO, this would be a lot simpler if you used Styles for the formatting. As far as I can tell, too, you don't need any complicated arrays. Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrTmp As String: Const StrAcc As String = "m7#b"
On Error Resume Next
With ActiveDocument
  .Styles.Add "Chord", wdStyleTypeParagraph 'wdStyleTypeCharacter
  .Styles("Chord").Font.ColorIndex = wdBlue
End With
On Error GoTo 0
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-F][m7#b ^13]"
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .Paragraphs(1).Style = "Chord" Then
      .End = .Paragraphs(1).Range.End
    Else
      StrTmp = Split(.Paragraphs(1).Range.Text, vbCr)(0)
      For i = 1 To Len(StrAcc)
        StrTmp = Replace(StrTmp, Mid(StrAcc, i, 1), "")
      Next
      For i = 1 To 7
        StrTmp = Replace(StrTmp, Chr(64 + i), "")
      Next
      StrTmp = Trim(StrTmp)
      If StrTmp = "" Then .Paragraphs(1).Style = "Chord"
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "\[[!\[]@\]"
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
      Select Case .Text
        Case "[Chorus]": .HighlightColorIndex = wdYellow: .Style = wdStyleStrong
        Case "[Verse]": .HighlightColorIndex = wdNoHighlight: .Font.Reset
        Case "[Bridge]": .HighlightColorIndex = wdBrightGreen: .Style = wdStyleStrong
      End Select
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Move Selection to the next Column on a Page (Not a table) Insert Table To Multi Column Page mertdogan Word Tables 2 08-03-2017 03:46 PM
Move Selection to the next Column on a Page (Not a table) Center a table column on page Mutak94 Word Tables 1 09-12-2014 02:52 PM
Move Selection to the next Column on a Page (Not a table) Selection of all Text for a specific page in word is spanning selection across pages ramsgarla Word VBA 9 12-05-2012 03:23 AM
Columns. How to move the left column so it's to the right of the 'right' column ? Vit Word 9 11-21-2012 12:57 PM
Move Selection to the next Column on a Page (Not a table) Long, 3 Column Table - Can I make Fit Into Page Columns? Rigwald Word Tables 9 08-07-2012 08:14 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:08 PM.


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