![]() |
#1
|
|||
|
|||
![]()
I'm writing a macro which extracts songs from a master songbook and puts them a new document. I've got it all working (thanks to macropod), but I need an enhancement.
I want to find the first instance of "[x]" in red (where [x] is the musical key of the song eg [Am], [C] etc) within the range of the song I have just set. I want to copy this (including the brackets) into a variable (SongKey) for later pasting into a table also with the song title. Here is the section of code which extracts the song and it's title. I've marked the sport where I need to copy the [x], but I have no idea how to select text by colour. Also the string may be 3 OR 4 characters long, including brackets, but always ends with a "]". Any help appreciated. Apologies I do not yet know how to make pasted code look neat. ' GET WHOLE SONG (always only one page) Windows(LatestSongbook).Activate Set rng = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=NextPage) ' marks START of page range Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=NextPage ' marks END of page range (ie 1 page only) rng.End = Selection.Bookmarks("\Page").Range.End ' marks physical end of page rng.Copy ' HERE: need to find first instance of "[x]" in red (where [x] is the musical key of the song, eg [C], [Am] etc) ' need to copy this text, including start and end bracket into a variable SongKey for later insertion into the set list table Set rng = rng.Paragraphs(1).Range ' gets song title (para 1) for later insertion into set list table SongTitle = rng.Text SongTitle = Left(SongTitle, Len(SongTitle) - 1) ' trim style separator off end of title PS: the Red is RGB(255,0,0) Last edited by MJH001; 09-22-2025 at 08:46 AM. Reason: Added a PS to clarify colour |
#2
|
||||
|
||||
![]()
It would be helpful if you attached a sample document to your post showing exactly what you're dealing with.
Perhaps you could also explain what Windows(LatestSongbook).Activate is for, too. Its presence in your code suggests you're switching back & forth between documents, which shouldn't be necessary and really slows down your code.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
![]()
Attached is a link to a Word doc sample of the Songbook from which I am extracting whole songs to go into a new doc "GigName". The list of page numbers is in a workbook named "SetListCreator". Whilst extracting the songs, I'm also extracting the title to paste next to the page number.
The reason for activating the sheets is that I don't know any other way. I assume I have to Activate the SetListCreator.doc to get the next page number, Activate the LatestSongbook to copy the relevant page, Activate the GigName doc to paste the song in, and Activate the SetListCreator again to paste the song title next to the pabe number. https://www.msofficeforums.com/attac...1&d=1758882020 The additional extraction is the song key, so on the case of the attached sample the red [G] from page 1, [Am] from p2, [G] from p3, and [F] from p4. Note that on p4 I would not want the [F / / /]. The song key is always 1 or 2 A-Z characters inside square brackets [ ]. Your assistance is greatly appreciated. |
#4
|
||||
|
||||
![]()
Now I'm confused. You keep referring to worksheets - which are Excel properties - and a workbook named "SetListCreator", but then you seem to refer to it as SetListCreator.doc - which implies a Word document.
Perhaps you would be so good as to explain precisely what you're doing and post the code too. For a macro to Find content in one document and insert it into another document without all the window switching, see: https://www.msofficeforums.com/128621-post2.html
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
![]()
Sorry to cause confusion. It's all in word. I got myself muddled as the original SetListCreater was a spreadsheet, but I'm switching to do it all in Word.
Here's the code link: (I hope it works - it says it's attached in the little paper clip on the ribbon) GigBook Macro1.docx Meanwhile, I'll take a look at the link you sent about accessing different docs without Activating them every time. Thanks again. |
#6
|
||||
|
||||
![]()
Try the code below. I've tidied up your code somewhat, reducing it to just 84 lines instead of close to 200, plus it's now way more efficient.
Some points to note: 1. Your hard-coded LatestSongbook has been replaced by a FilePicker dialog 2. Nothing gets selected or copied & pasted and no window switching is done and you'll see no window flickering, etc. 3. I wasn't sure where you want the musical key to go, so I've output it to an assumed column 4 of the table. You might want to change that. Code:
Sub Demo() Application.ScreenUpdating = False Dim GigNum As String, GigName As String, GigDate As String, GigLoc As String, GigPost As String, GigTime As String, GigFile As String Dim DocSrc As Document, DocRef As Document, DocTgt As Document, Rng As Range, r As Long, p As Long, Fld As Field, StrKey as String With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker) .Title = "Select the Song Book": .AllowMultiSelect = False .Filters.Clear: .Filters.Add "Documents", "*.doc; *.docx; *.docm", 1 .InitialFileName = "D:\Documents\MJH-20\MJH-Music\LotSU\LotSU Songbooks\" If .Show = -1 Then Set DocRef = Documents.Open(.SelectedItems(1), ReadOnly:=True, Visible:=False, AddToRecentFiles:=False) Else MsgBox "No Song Book selected. Exiting", vbExclamation: Exit Sub End If End With Set DocSrc = Documents.Open(FileName:="C:\Users\" & Environ("Username") & "\Desktop\SetListCreator.docx", ReadOnly:=True, Visible:=False, AddToRecentFiles:=False) Set DocTgt = Documents.Add With DocSrc With .Tables(1) GigNum = Split(.Cell(1, 1).Range.Text, vbCr)(0) GigName = Split(.Cell(1, 2).Range.Text, vbCr)(0) GigDate = Split(.Cell(1, 3).Range.Text, vbCr)(0) GigPost = Split(.Cell(2, 1).Range.Text, vbCr)(0) GigLoc = Split(.Cell(2, 2).Range.Text, vbCr)(0) GigTime = Split(.Cell(2, 3).Range.Text, vbCr)(0) GigFile = Mid(GigDate, 4) & Mid(GigDate, 4, 2) & Left(GigDate, 2) & GigName & " Songs" End With With DocTgt With .PageSetup .Orientation = wdOrientPortrait .TopMargin = CentimetersToPoints(0.5) .BottomMargin = CentimetersToPoints(0.5) .LeftMargin = CentimetersToPoints(1) .RightMargin = CentimetersToPoints(0.5) .Gutter = CentimetersToPoints(0) .HeaderDistance = CentimetersToPoints(0.5) .FooterDistance = CentimetersToPoints(0.5) .PageWidth = CentimetersToPoints(21) .PageHeight = CentimetersToPoints(29.7) .FirstPageTray = wdPrinterDefaultBin .OtherPagesTray = wdPrinterDefaultBin .SectionStart = wdSectionNewPage .VerticalAlignment = wdAlignVerticalTop .BookFoldPrintingSheets = 1 .GutterPos = wdGutterPosLeft End With With .Range .ParagraphFormat.Alignment = wdAlignParagraphCenter .Text = vbCr & vbCr & vbCr & GigNum .Paragraphs.Last.Range.Font.Size = 24 .InsertAfter vbCr & vbCr & GigName & vbCr & vbCr & GigLoc & vbCr & vbCr & GigPost & vbCr & vbCr & GigDate & vbCr & vbCr & GigTime & Chr(12) .Paragraphs(7).Range.Font.Size = 36 End With End With With .Tables(1) For r = 3 To .Rows.Count If Len(.Cell(r, 1).Range.Text) = 2 then Exit For p = Split(.Cell(r, 1).Range.Text, vbCr)(0) + 6: StrKey = "" Set Rng = DocRef.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=p).GoTo(What:=wdGoToBookmark, Name:="\page") DocTgt.Range.Characters.Last.FormattedText = Rng.FormattedText .Cell(r, 1).Range.Text = r - 2: .Cell(r, 3).Range.Text = Split(Rng.Paragraphs.First.Range.Text, vbCr)(0) With Rng With .Find .ClearFormatting .Replacement.ClearFormatting .Font.Color = RGB(255, 0, 0) .Execute FindText:="\[[A-G]*\]", MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True, Format:=True, ReplaceWith:="" End With If .Find.Found = True Then StrKey = .Text End With .Cell(r, 4).Range.Text = StrKey Next End With With DocTgt For Each Fld In .Fields If Fld.Type = wdFieldTOCEntry Then Fld.Code.Paragraphs(1).Range.Text = vbNullString End If Next .SaveAs2 FileName:="D:\Documents\MJH-20\MJH-Music\LotSU\Gig Sheets\" & GigFile & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False .SaveAs2 FileName:="D:\Documents\MJH-20\MJH-Music\LotSU\Gig Sheets\" & GigFile & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False .Close False End With .SaveAs2 FileName:="D:\Documents\MJH-20\MJH-Music\LotSU\Gig Sheets\" & GigFile & "Set.pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False .Close False End With DocRef.Close False: Set Rng = Nothing: Set DocSrc = Nothing: Set DocRef = Nothing: Set DocTgt = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
![]()
Thank you so much. This is fantastic and I shall try to learn from this by studying and trying to understand what you've written.
Most of my limited macro coding has been done by recording keystrokesand then tweaking. I guess this makes for inefficient code. I've tried to run the code, but get a compile error. This was in this section near the end: For Each Fld In .Fields If Fld.Type = wdFieldTOCEntry Then Fld.Paragraphs(1).Range.Text = vbNullString End If Next The word 'Paragraphs' was highlighted with a 'Method or data member not found' message. Thanks again, Jeremy |
#8
|
||||
|
||||
![]()
Oops! That should have been:
Fld.Code.Paragraphs(1).Range.Text = vbNullString Fixed. Try it now. PS: I've added a few more tweaks to the code.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
![]()
Thanks again, Paul. I've gotten myself all tied up on page numbering.
In this bit of code: Code:
p = Split(.Cell(r, 1).Range.Text, vbCr)(0) + 6: StrKey = "" If p = 6 Then Exit For Set Rng = DocRef.GoTo(What:=wdGoToPage, Name:=p).GoTo(What:=wdGoToBookmark, Name:="\page") DocTgt.Range.Characters.Last.FormattedText = Rng.FormattedText If instead I use "Count:=p", I do need to add 6 to get the correct song. I found it was 6 through trial and error, as the first song is on the 5th physical page so adding 6 should get page 7, but it gets the 5th. This works apart from the first song. Whatever p number is first in the list, the command returns the whole of the source document from that song onwards. So if I have 1, 2, 3 in my list, I get songs 1-138, then song 2, then song 3. In summary, if I use "Name:=p" (without the +6) I can't retrieve the first 4 songs by number. If I use "Count:=p" (with +6) I get the rest of the song book from that first listed page on, followed by the correct songs. Incidentally, the end of list detection throws up an error - presumably because we can't use Split on an empty cell? I got round this be testing for len=2 as the next empty table cell will just contain Cr & Lf. Your continued help is greatly appreciated. Jeremy Last edited by MJH001; 10-06-2025 at 03:55 AM. Reason: typo |
#10
|
||||
|
||||
![]()
In that case, you could probably use something like:
Code:
If Len(.Cell(r, 1).Range.Text) = 2 then Exit For p = Split(.Cell(r, 1).Range.Text, vbCr)(0) + 6: StrKey = "" Set Rng = DocRef.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=p).GoTo(What:=wdGoToBookmark, Name:="\page")
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
![]()
Thanks Paul - that did the trick.
|
![]() |
Tags |
color font, find character |
Thread Tools | |
Display Modes | |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Sorting song lyrics | Lakshman | Word | 2 | 08-17-2021 07:17 AM |
![]() |
aclare | PowerPoint | 5 | 04-09-2017 01:48 AM |
![]() |
beedee | PowerPoint | 1 | 05-04-2014 10:21 AM |
![]() |
Mihai_VRD | PowerPoint | 1 | 04-17-2012 01:06 AM |
Please help......[embed song in presentation] | elmcity | PowerPoint | 0 | 01-09-2010 12:00 AM |