#16
|
|||
|
|||
Loop through listboxes in Application.OrganizerCopy
Macropod,
Thanks so much for your assistance! It's been a huge help. Now it looks good - I added a third style filter option - one that loads all the styles - to the other two. I have tested the error trap this way and it works fine from what I've seen so far. As for why the code errors on some styles, according to http://windowssecrets.com/forums/sho...A-Word-2003%29, the styles “Comment Reference” through “Strong” are built-in character styles that cannot be deleted. That pertains to Word 2003 and are probably many others for later versions. Even though the Style Copier is not deleting, perhaps there is something about these and other undeletable styles that conflict with the copy code. If I click the "Show All Styles, INCLUDING Built-Ins" option from the test Headings 1-2 file (272 in all) and try to copy all of them to a file, your error trap removes all but 60 of them. If I click the "Show Only Styles in Use" option, I get 60 styles. I didn't compare the two lists, but I bet they're the same. I just noticed one issue with the Target Files box (Listbox3). The intention is to allow one to select files from one or more drives, but once files have been selected, invoking the Open File button (Sub CmdTarget_Click) overwrites whatever file names are already in Listbox3 (actually it overwrites the number of items in the listbox with the number of files selected, going to to bottom). I need to retain these and append the newly selected files, but can't work out the code for that. Can you help with that? I've attached the latest version so you can see the changes (I haven't addressed cleaning up the format or aligning the object in the form yet; just want to get the code working properly for now). |
#17
|
||||
|
||||
Hi Marrick,
Try the following (untested) revision to the 'With ListBox3 .. End With' portion of your 'CmdTarget_Click' sub: Code:
With ListBox3 If .ListCount = 0 Then .ColumnCount = 2 .ColumnWidths = "0; 60" i = 0 Else i = .ListCount - 1 End If End With
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#18
|
||||
|
||||
Hi Marrick,
Something I've noticed is that all of the builtin Table Styles, except for 'Table Normal' are in the error list, as are all of the builtin Character Styles, except for 'Default Paragraph Font' are in the error list. Rather than having all these Styles (and the few other Problem styles) loaded & then all except maybe one or two reported as errors, you could modify the PopulateSourceList sub by adding the following If test to your 'For Each aStyle In ActiveDocument.Styles' loop, thus: Code:
Dim StrStyExclList As String StrStyExclList = "|1 / 1.1 / 1.1.1|1 / a / i|Article / Section|" For Each aStyle In ActiveDocument.Styles If aStyle.BuiltIn = True Then If aStyle.Type <> wdStyleTypeTable And aStyle.Type <> wdStyleTypeCharacter _ And InStr(StrStyExclList, "|" & aStyle.NameLocal & "|") = 0 Then ListBox1.AddItem (aStyle) CountSourceStyles = CountSourceStyles + 1 lblSourceCount.Caption = "(" & CountSourceStyles & ")" End If Else ListBox1.AddItem (aStyle) CountSourceStyles = CountSourceStyles + 1 lblSourceCount.Caption = "(" & CountSourceStyles & ")" End If Next aStyle
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#19
|
|||
|
|||
Loop through listboxes in Application.OrganizerCopy
Paul (sorry, just realized that was your name!)
The code for appending the target file listbox did the trick - thank you! I also applied the code you provided to filter the builtins. When I run it for the template Headings 1-2 test file now (selecting the top radio button), I get 102 styles, whereas before I got 272. Does that mean 170 styles are problem children? Your trouble list had only 64 styles. Funny that 1 / 1.1 / 1.1.1|1 / a / i|Article / Section are in the Organizer list, at least for the test source file, although Organizer doesn't show 272 styles, or even 100 (about 45 for this file). Seeing your revised code, I'm tempted to add ANOTHER option to list all 272 styles, but perhaps you're right - it doesn't help anything. When I selected all 272 styles and ran the copy in the previous version, the message box was filled so much with the uncopiable style names I couldn't access the OK to close it. Since it stripped away all but 60, I guess it couldn't handle 212 of them. Showing so many styles that can't be copied and letting the error trap pull them out doesn't make much sense, so I think I will go with your changes. I've attached the latest version if you want it. Thanks again so much for your help - I really appreciate it! |
#20
|
||||
|
||||
Hi Marrick,
I guess it's possible your installation has 170 problem Styles. If you wanted to be sure, you could turn off the 'load' filter and modify the message box code to output the list in your Style Copier document.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#21
|
|||
|
|||
Hi Paul,
I think I already did that when I selected all 272 styles and ran the copy code; that's when the message box grew too large to display fully on the screen. But you gave me an idea...maybe I will add a "filter" checkbox to the first builtin option that removes the problem styles. That way a user will have the option of never having to deal with however many problem styles he has, or of seeing all the styles. Thanks again and cheers! |
#22
|
|||
|
|||
Loop through listboxes in Application.OrganizerCopy (II)
The Target listbox (Listbox3) needs a filter in the Sub CmdTarget_Click module to remove duplicate file names (unless their folders are unique). The way it works now is if the list is empty and I select one file from a source folder, that file appears in the list (as it should). If I select the same file from the same source folder, nothing happens, but if I select the same file from the source AGAIN, it is appended to the listbox. This produces two listings of the same file - this is not what I want. If there is at least one item in Listbox3 and I select a different file TWICE (same file name), that file will appear twice in the listbox.
I would like to be able to select any files in any folder and have the code filter by filename AND folder name, so that the same filename can appear in the list more than once, but only if each is contained in a different folder. Otherwise, there can be no duplication of the filename. I found some code online that filters for unique items in a listbox at http://www.tech-archive.net/Archive/.../msg00199.html, but I cannot get it to work in the Style Copier. I'm sure this is because of my great lack of VBA skill but may be partly because its Listbox3 is two columns and I doubt that online code will work for two columns. Have attached the latest version of Style Copier and would appreciate assistance. |
#23
|
||||
|
||||
Hi Marrick,
To prevent the duplicates, you could do something like: Code:
Private Sub CmdTarget_Click() Dim TargetFile As Variant, i As Long, StrFiles As String, StrDupes As String 'Create a FileDialog object as a File Picker dialog box. With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker) .Filters.Clear .Filters.Add "All Word Documents", "*.doc; *.dot; *.rtf; *.docx; *.docm; *.dotx; *.dotm", 1 .AllowMultiSelect = True If .Show = -1 Then ' User clicked OK; show last accessed drive Label6.Caption = "Most recent target drive: " & Left(.SelectedItems(1), InStrRev(.SelectedItems(1), "\")) With ListBox3 If .listcount = 0 Then .ColumnCount = 2 .ColumnWidths = "0; 60" i = 0 Else StrFiles = "|" For i = 0 To .listcount - 1 StrFiles = StrFiles & .List(i, 0) & "|" Next i = .listcount - 1 End If End With ' Populate the listbox For Each TargetFile In .SelectedItems If InStr(StrFiles, "|" & TargetFile & "|") = 0 Then ListBox3.AddItem (TargetFile) ListBox3.Column(1, i) = Split(TargetFile, "\")(UBound(Split(TargetFile, "\"))) 'gets the filename i = i + 1 Else StrDupes = StrDupes & vbCr & TargetFile End If Next If StrDupes <> "" Then MsgBox "The following files were already selected: " & StrDupes, vbExclamation, "Duplicate Selection" ' Report the file count lblTargetCount.Caption = "(" & .SelectedItems.Count & ")" CopyButtonState ResetButtonState Else ' User clicked Cancel Exit Sub End If End With 'Call Box2Populate End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#24
|
|||
|
|||
Brilliant! Thank you, Paul! This is almost what I am looking for. I did test this under different scenarios and here are the results:
With an empty listbox... 1) I select one file, then click Open File and select the same file from the same source folder. Result: Duplicate Selection message appears - OK. 2) I select one file, then click Open File and select the same file from a different source folder (the code is supposed to allow this). Result: The code allows the file (there is no Dup. Mssg) but only one of the filenames appears in the listbox. The list counter changes from 1 to 2. The counter is correct but the filename should appear with the other. 3) I select two files at the same time from the same source folder. The two files appear in the listbox. List counter accurately shows 2. Then I select three files from another folder; two have the same names as the first two from another folder. Result: Four files appear in the listbox instead of five. List counter is 5, which is correct. Also, listbox3 should be sorted, but it's a multi-column box and I have only sort code (non-array) for regular listboxes. +++++++++++++++++++++++++++++++++ I changed the counter for Listbox3 from 'lblTargetCount.Caption = "(" & .SelectedItems.Count & ")" to CountTargetFiles = ListBox3.listcount lblTargetCount.Caption = "(" & CountTargetFiles & ")" |
#25
|
||||
|
||||
Hi Marrick,
I think you'll need a different approach if you're going to allow the same filenames to be selected from differrent folders. For example, if the code is modified to allow both entries to appear, how is the user to differentaite them if it is decided to delete one? As for your last change, that could be simplified to: lblTargetCount.Caption = "(" & ListBox3.listcount & ")" The same applies to all your other list counts.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#26
|
|||
|
|||
I guess you're right, Paul. I was trying to accommodate the scenario where one might have the same file or filename in more than one location, but while possible, it is not likely. If it complicates things further, then I should prevent any duplicates. But the previous code did not do that, and your latest version filters only if duplicates are selected from the same folder. How can I change it to always filter out dupes regardless of source (and retain the complete folder path in the msg box)?
|
#27
|
||||
|
||||
Hi Marrick,
Try: Code:
Private Sub CmdTarget_Click() Dim TargetFile As Variant, i As Long, StrFiles As String, StrDupes As String 'Create a FileDialog object as a File Picker dialog box. With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker) .Filters.Clear .Filters.Add "All Word Documents", "*.doc; *.dot; *.rtf; *.docx; *.docm; *.dotx; *.dotm", 1 .AllowMultiSelect = True If .Show = -1 Then ' User clicked OK; show last accessed drive Label6.Caption = "Most recent target drive: " & Left(.SelectedItems(1), InStrRev(.SelectedItems(1), "\")) With ListBox3 If .ListCount = 0 Then .ColumnCount = 2 .ColumnWidths = "0; 60" i = 0 Else StrFiles = "|" For i = 0 To .ListCount - 1 StrFiles = StrFiles & .List(i, 1) & "|" Next i = .ListCount - 1 End If End With ' Populate the listbox For Each TargetFile In .SelectedItems If InStr(StrFiles, "|" & Left(TargetFile, InStrRev(TargetFile, "\")) & "|") = 0 Then ListBox3.AddItem (TargetFile) ListBox3.Column(1, i) = Split(TargetFile, "\")(UBound(Split(TargetFile, "\"))) 'gets the filename i = i + 1 Else StrDupes = StrDupes & vbCr & Left(TargetFile, InStrRev(TargetFile, "\")) End If Next If StrDupes <> "" Then MsgBox "The following files were already selected: " & StrDupes, vbExclamation, "Duplicate Selection" Call UpdateCounters End If End With End Sub Code:
Private Sub PopulateSourceList() Application.ScreenUpdating = False 'You must OPEN the source document Dim StrStyExclList As String StrStyExclList = "|1 / 1.1 / 1.1.1|1 / a / i|Article / Section|" 'identifies styles to exclude from builtin list CountSourceStyles = 0 If OptAllBltInYes.Value = True Then StyleInd = 1 If OptAllBltInNo.Value = True Then StyleInd = 2 If OptInUse.Value = True Then StyleInd = 3 Select Case StyleInd Case 1 If ChkFilter.Value = True Then 'get all styles, but filter out problem built-ins For Each aStyle In ActiveDocument.Styles If aStyle.BuiltIn = True Then If aStyle.Type <> wdStyleTypeTable And aStyle.Type <> wdStyleTypeCharacter _ And InStr(StrStyExclList, "|" & aStyle.NameLocal & "|") = 0 Then ListBox1.AddItem (aStyle.NameLocal) End If Else ListBox1.AddItem (aStyle.NameLocal) End If Next aStyle Else 'get all styles including built-ins For Each aStyle In ActiveDocument.Styles ListBox1.AddItem (aStyle.NameLocal) Next aStyle End If Case 2 'get all styles excluding built-ins For Each aStyle In ActiveDocument.Styles If aStyle.BuiltIn = False Then ListBox1.AddItem (aStyle.NameLocal) End If Next aStyle Case 3 If ChkFilter.Value = True Then 'get all styles in use, but filter out problem built-ins For Each aStyle In ActiveDocument.Styles If aStyle.BuiltIn = True And aStyle.InUse Then 'get only builtin styles in use If aStyle.Type <> wdStyleTypeTable And aStyle.Type <> wdStyleTypeCharacter _ And InStr(StrStyExclList, "|" & aStyle.NameLocal & "|") = 0 Then ListBox1.AddItem (aStyle.NameLocal) End If Else Next Else For Each aStyle In ActiveDocument.Styles If aStyle.InUse Then 'get only styles in use ListBox1.AddItem (aStyle.NameLocal) End If Next aStyle End If End Select Call UpdateCounters If ListBox1.ListCount = 0 Then MsgBox "There are no applicable styles in the source document." Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#28
|
|||
|
|||
Thanks Paul. In the Sub PopulateSourceList module, I'm getting a "Next without For" error on the "next" in Case 3. I made this "Next astyle" but it didn't help, nor did adding another "end if" above it and commenting out the "next". I'm having too much trouble following the logic to figure out how to fix this so the code runs all the way through.
Also, how do I sort the target box (listbox3) with its two columns (sort it by the file name)? |
#29
|
||||
|
||||
Hi Marrick,
Oops! To fix the error, change: Code:
Else Next Code:
End If Next
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#30
|
|||
|
|||
Loop through listboxes in Application.OrganizerCopy
Paul,
Thanks for the correction. The code runs withour error, but I'm still seeing an issue with adding other docs to the target listbox3 in the Sub CmdTarget_Click module: 1. If I choose one target file, it displays in the list; the listcounter shows as "1." But then when I select another file (from same or different source folder), the new doc overwrites the original in the list (so there is one doc listed); listcounter shows as "2" which is correct. 2. If I choose two target files, they display in the list; listcounter shows as "2." But then when I select another file (from same or different source folder), the new doc overwrites the bottom original in the list (so there are two docs listed); listcounter shows as "3" which is correct. I still also would like this listbox to be sorted but it's a two-column box - how to do that? I have another problem with a msgbox I just added to the Sub CmdCopyStyle_Click module. The intention is to display a textbox reading "Processing..." as soon as the copy routine starts ("Me.txtProcessing.Visible = True"). When I step thru the code, the textbox displays and shuts off at the end when another textbox displays showing the number of styles copied to the number of documents. But during runtime the "Me.txtProcessing.Visible = True" has no effect; if I comment out the statement that shuts it off when the other stats textbox becomes visible, then the txtProcessing textbox displays (so both appear at the same time, but only after the copy code has run). I even placed a beep just before the "Me.txtProcessing.Visible = True" and it did beep during runtime but still didn't display the textbox. If I place an exit sub right after the statement, the textbox displays (but of course the code stops). So then I tried some code to delay the macro and even put the whole module in another module and ran the display code separately to see if I could "fool" VBA, but nothing worked. I also tried adding if statements, and that didn't do anything. So there's apparently something about the loop code that prevents the textbox from displaying (but only during runtime). Any idea why the txtProcessing doesn't display when it should during runtime? Latest version is attached. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to use for loop in formula in VBA? | tinfanide | Excel Programming | 1 | 12-06-2011 08:33 AM |
music loop in powerpoint presentation | genoMU69 | PowerPoint | 1 | 06-15-2011 08:00 AM |
While loop not working right | Cbrehm | Excel Programming | 0 | 05-11-2011 11:05 AM |
Continuous Loop | cksm4 | Word | 6 | 01-06-2011 09:03 PM |
Outlook 2003 restart in a loop | Stegel | Outlook | 0 | 06-29-2007 12:34 PM |