View Single Post
 
Old 05-12-2019, 06:22 PM
Steve Kunkel Steve Kunkel is offline Windows 10 Office 2016
Advanced Beginner
 
Join Date: May 2019
Location: Seattle area
Posts: 81
Steve Kunkel is on a distinguished road
Default

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
The code for the form is this one
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
And the find/replace function that gets called is
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
End

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.
Attached Files
File Type: zip 1PsychRep.zip (79.9 KB, 6 views)
Reply With Quote