![]() |
#4
|
|||
|
|||
![]()
Thanks for the replies. I don't think there is anything else that should affect the caption. I'll zip/attach the .dotm file.
Also, I'll paste the three sections of code. Sorry it's so messy. BTW I'm open to any general stylistic recommendations. Document_Open() one Code:
Private Sub Document_New() 'Automatically runs when this document is opened. formMain.Controls(optSch1).Caption = "School One" formMain.Controls(optSch2).Caption = "School Two" formMain.Controls(optSch3).Caption = "School Three" formMain.Show End Sub Code:
Private Sub cmdActivate_Click() 'when button is clicked 'make sure the user has entered the student's first and last names.============== If TextBoxfNAME.Text = "" Then MsgBox ("Enter student's first name!") 'Then skip to the bottom of the Sub GoTo NoNameLine End If If TextBoxlNAME.Text = "" Then MsgBox ("Enter student's last name!") GoTo NoNameLine End If '========================================================================= 'check to see if there is already a report for that student.===================== Dim strDocTypeForName As String ' Used for renaming the file e.g. "Jon Doe -- Reeval 3-28-2019" Dim strDocTypeForReplace As String ' Used for Find and Replace in acual document. Dim proposedDocName As String Dim strMsg As String On Error GoTo NoDirError If optSch1.Value = True Then ' 'NOTE: If the location of the folder changes, ' 'this directory path will need to be changed too. ChangeFileOpenDirectory "C:\Users\swkunkel\Google Drive\@WorkingDocs\@KMS19" End If If optSch2.Value = True Then ChangeFileOpenDirectory "C:\Users\swkunkel\Google Drive\@WorkingDocs\@NKHS19" End If If optSch3.Value = True Then ChangeFileOpenDirectory "C:\Users\SWKunkel\Google Drive\@WorkingDocs\@Wolfle19" End If If optSch4.Value = True Then ChangeFileOpenDirectory "C:\Users\swkunkel\Google Drive\@WorkingDocs\@Other" End If GoTo NoErrorLine NoDirError: MsgBox ("This message means that your code points to a folder that does not exsist." _ & vbCrLf & (TextBoxfNAME) & "'s report will be put in the default location for Word docs (Probably 'My Documents'). See Tips.") NoErrorLine: 'Report=type=frame====================================================== If optInitial.Value = True Then strDocTypeForReplace = "evaluation" strDocTypeForName = "Initial" End If If optReeval.Value = True Then strDocTypeForReplace = "reevaluation" strDocTypeForName = "Reeval" End If If OptFBA.Value = True Then strDocTypeForReplace = "FBA" strDocTypeForName = "FBA" End If If optScreen.Value = True Then strDocTypeForReplace = "screen" strDocTypeForName = "Screen" End If '========================================================== proposedDocName = ((TextBoxfNAME) & " " & (TextBoxlNAME) & " -- " & (strDocTypeForName)) ' Message to return if file exists. strMsg = "There is already a report called " & proposedDocName & ". Do you want to continue with this one? (It could possibly replace the other one!) Press [Yes] to continue or press [No] to just close this so you can go open the other one." ' Check if the file exists. If Dir(proposedDocName & "*") = "" Then ' the file does not exist, so just continue. GoTo ContinueWithReplacementsLine Else 'the file does exist, so prompt with warning message. Select Case MsgBox(strMsg, vbYesNo + vbExclamation) Case vbYes ' If Yes was chosen, save and overwrite existing file. GoTo ContinueWithReplacementsLine Case Else ' If No was chosen, formMain.hide Application.ScreenUpdating = False ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges End Select End If 'this is the end of checking to see if it already exsists.===================== ContinueWithReplacementsLine: formMain.hide 'make custom form disapear while the replacements and renaming happens. 'Student=name=frame=============================================== 'Go to other module for first and last name replacments Call DoFindReplace("[n]", (TextBoxfNAME)) Call DoFindReplace("[l]", (TextBoxlNAME)) If TextBoxnNAME.Text = "" Then 'There is no nickname, so... Call DoFindReplace("[k]", (TextBoxfNAME)) 'use first name. End If If TextBoxnNAME.Text <> "" Then Call DoFindReplace("[k]", (TextBoxnNAME)) End If 'Go to the footer module and make replacements. ' Call DoFooterReplace("[n]", (TextBoxfNAME)) ' Call DoFooterReplace("[l]", (TextBoxlNAME)) '==================================== 'Student=gender=frame=============================================== If optMale.Value = True Then 'he/she replacements are set to the male pronouns Call DoFindReplace("[e]", "he") Call DoFindReplace("[m]", "him") Call DoFindReplace("[s]", "his") End If If optFemale.Value = True Then 'use female pronouns Call DoFindReplace("[e]", "she") Call DoFindReplace("[m]", "her") Call DoFindReplace("[s]", "her") End If If optNeutral.Value = True Then 'use gender-neutral pronouns Call DoFindReplace("[e]", "they") Call DoFindReplace("[m]", "them") Call DoFindReplace("[s]", "their") End If '========================================================= 'Save=to=folder=frame================================================= If optSch1.Value = True Then Call DoFindReplace("[b]", "Kingston Middle School") End If If optSch2.Value = True Then Call DoFindReplace("[b]", "North Kitsap High School") End If If optSch3.Value = True Then Call DoFindReplace("[b]", "Wolfle Elementary") End If If optSch4.Value = True Then Call DoFindReplace("[b]", (txtOptSch4)) End If '============================================================ Call DoFindReplace("[v]", (strDocTypeForReplace)) '=======Add custom properties======= With ActiveDocument.CustomDocumentProperties .Add Name:="FirstName", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=TextBoxfNAME.Text .Add Name:="LastName", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=TextBoxlNAME.Text .Add Name:="NickName", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=TextBoxnNAME.Text 'Student=gender=frame=again============ If optMale.Value = True Then .Add Name:="HeShe", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="he" .Add Name:="HimHer", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="him" .Add Name:="HisHer", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="his" End If If optFemale.Value = True Then .Add Name:="HeShe", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="she" .Add Name:="HimHer", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="her" .Add Name:="HisHer", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="her" End If If optNeutral.Value = True Then .Add Name:="HeShe", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="they" .Add Name:="HimHer", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="their" .Add Name:="HisHer", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="their" End If '========================== 'Report=type=frame=again=================== If optInitial.Value = True Then .Add Name:="ReportType", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="evaluation" End If If optReeval.Value = True Then .Add Name:="ReportType", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="reevaluation" End If If OptFBA.Value = True Then .Add Name:="ReportType", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="FBA" End If If optScreen.Value = True Then .Add Name:="ReportType", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="screen" End If '=================================== If optSch1.Value = True Then .Add Name:="SchoolBuilding", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="KMS" End If If optSch2.Value = True Then .Add Name:="SchoolBuilding", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="NKHS" End If If optSch3.Value = True Then .Add Name:="SchoolBuilding", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="Wolfle" End If If optSch4.Value = True Then .Add Name:="SchoolBuilding", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=txtOptSch4 End If End With 'end of assigning custom properties 'Give the report its custom name ActiveDocument.SaveAs FileName:=(TextBoxfNAME) & " " & (TextBoxlNAME) & " -- " & (strDocTypeForName) & " " & Format(Date, "mm-dd-yyyy") 'Saves it like "John Doe -- Reeval 11-8-10.doc" Unload formMain 'You get redirected here from "goto," above. NoNameLine: End Sub Private Sub cmdCANCEL_Click() 'This just completes the Subroutine without making any changes to the doc. formMain.hide Unload formMain End Sub Private Sub cmdTips1_Click() MsgBox ("Press <Tab> to navigate between fields and press <Space> to activate a selected option button" & vbCrLf & _ vbCrLf & "The prose and tables in the report can be changed as needed. Also, snippets can be saved using Word's 'Quick Parts' feature. To make permanent changes to the Template, you must open the Template a special way... RIGHT CLICK the file and choose 'Open' that way--Edit, then save." & vbCrLf _ & vbCrLf & " The replacements keys the macro uses are:" _ & vbCrLf & " [n] = First name " & vbCrLf & " [l] = Last name " & vbCrLf & " [k] = Nickname " & vbCrLf & " [e] = 'he' or 'she'" & vbCrLf & " [m] = 'him' or 'her.'" & vbCrLf & " [s] = 'his' or 'her.'" & vbCrLf & " [v] = 'reevaluation' or 'evaluation.'" & vbCrLf & " [b] = One of the building names." & vbCrLf _ & vbCrLf & vbCrLf & " Sample text: [n][l], also known as [k], now has [s] own [v]report about [m] at [s] homeschool which is [b]Elementary." _ & vbCrLf & vbCrLf & " Yeilds: Bartholomew Simpson, also known as Bart, now has his own evaluation report about him at his homeschool which is Springfiled Elementary." _ & vbCrLf & vbCrLf & " Or: Lisa Simpson now has her own reeval report about her at her homeschool which is Springfield Elementary.") End Sub Private Sub cmdTips2_Click() MsgBox ("If the 'Save-to-folder' function isn't working go to the code in Tools>Macros>VB Editor and right-click formMain, ViewCode... " _ & vbCrLf & "Find the line that looks like ChangeFileOpenDirectory 'C:\...' and change the path to match one from your computer." _ & vbCrLf & vbCrLf & "When first activated, the tool checks to see if there are already any documents that have the student's name. If you choose to continue, a new file will be made with today's date in the file's name. If one already exsists of the same type, from the same day, for the same student, it will get REPLACED with the new one." _ & vbCrLf & vbCrLf & "To use the alternate building box, make sure you've selected the 'enter below' one, and type the name of the building into the box. If nothing is entered, then '[b]' will be replaced with a blank space.") End Sub Code:
Sub DoFindReplace(FindText As String, ReplaceText As String) 'This module gets called from the MainForm code ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = FindText .Replacement.Text = ReplaceText .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll End Sub EDIT: Actually, it occurs to me that my form code doesn't have "UserForm_Initialize()." Should that appear near the top? I would actually prefer if the caption designations occurred on the same page as the main code. |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Larry_1 | Excel Programming | 3 | 12-18-2017 06:59 AM |
MACRO in infinite loop when it encounters user defined figure label | photoval | Word VBA | 3 | 02-02-2016 08:26 PM |
Variable arrays from user input | SeattleITguy | Excel Programming | 1 | 01-29-2015 09:19 AM |
![]() |
dsm1995gst | Word VBA | 1 | 09-03-2013 03:43 PM |
Task Form disappearing when assigned | zoids | Outlook | 0 | 03-27-2011 05:01 PM |