Command Button to Save Userform with dynamic name

[tapsmiled]

Hello,
I have UserForm: frmQA911 with ComboBox19: (last name, first name) and Textbox10: =TODAY()

I would like to save the form to a specific folder on the desktop ("Quality Assurance") as the following name: Smith, John_911_7/20/2014. This way, when the value in ComboBox19 and/or the date changes, a new file will be added to that folder.

Can anyone help?

If it can also be converted to a PDF, even better.

[tapsmiled]

Can anyone assist with this?

[Norie]

You can't save a userform.

[tapsmiled]

Can I convert a UserForm to some saveable file? PDF or otherwise?

[Norie]

You could transfer the data to a worksheet and then save the worksheet as a PDF.

Or you could write the data to a text file.

[tapsmiled]

 Option Explicit 
 
Private Sub CommandButton1_Click() 'submit button
    Sheets("DATA").Activate 
     'make sure text boxes aren't empty
    If TextBox3.Text = "" Then 
        MsgBox "Enter Date" 
        Exit Sub 
    End If 
     
    If TextBox4.Text = "" Then 
        MsgBox "Enter Analyst" 
        Exit Sub 
    End If 
     
    If TextBox1.Text = "" Then 
        MsgBox "Enter Request" 
        Exit Sub 
    End If 
     
    If TextBox2.Text = "" Then 
        MsgBox "Enter Issue" 
        Exit Sub 
    End If 
     
    Cells(2, 1) = TextBox3.Text 
    Cells(2, 2) = TextBox4.Text 
    Cells(2, 3) = TextBox1.Text 
     
    If CheckBox1.Value = True Then Cells(2, 4) = "PT50" 
    If CheckBox2.Value = True Then Cells(2, 5) = "QT04" 
    If CheckBox3.Value = True Then Cells(2, 6) = "QT05" 
    If CheckBox4.Value = True Then Cells(2, 7) = "ALL" 
    If CheckBox6.Value = True Then Cells(2, 8) = "9XX" 
    If CheckBox7.Value = True Then Cells(2, 9) = "CTD" 
    If CheckBox8.Value = True Then Cells(2, 10) = "UDF" 
    If CheckBox5.Value = True Then Cells(2, 11) = "OTHER" 
     
    Cells(2, 12) = TextBox2.Text 
     
     'TextBox3.Text = "" 'clears date field
     'TextBox3.SetFocus 'resets to date field
     
     'Unload UserForm1
     'ThisWorkbook.Close True
     
End Sub 
 
Private Sub CommandButton2_Click() 'cancel button
    Unload UserForm1 
End Sub 
 
Private Sub CommandButton3_Click() 'save button
     '   Creates word doc
    Dim WordApp As Object 
    Dim Data As Range, message As String 
    Dim Date1 As Date 
    Dim Analyst As String, Request As String, Regionpt50 As String 
    Dim Regionqt04 As String, Regionqt05 As String, Regionall As String 
    Dim Xx As String, Ctd As String, Udf As String, Other As String 
    Dim Issue As String 
    Dim SaveAsName As String 
     
     '   Start Word and create an object
    Set WordApp = CreateObject("Word.Application") 
     
     '   Information from worksheet
    Set Data = Sheets("DATA").Range("A2:L2") 
    message = Sheets("DATA").Range("N2") 
     
     '       Assign current data to variables
    Date1 = Data.Cells(2, 1).Value 
     'Date1 = Format(Data.Cells(2, 1).Value, "dd/mm/yyyy")
    Analyst = Data.Cells(2, 2).Value 
    Request = Data.Cells(2, 3).Value 
    Regionpt50 = Data.Cells(2, 4).Value 
    Regionqt04 = Data.Cells(2, 5).Value 
    Regionqt05 = Data.Cells(2, 6).Value 
    Regionall = Data.Cells(2, 7).Value 
    Xx = Data.Cells(2, 8).Value 
    Ctd = Data.Cells(2, 9).Value 
    Udf = Data.Cells(2, 10).Value 
    Other = Data.Cells(2, 11).Value 
    Issue = Data.Cells(2, 12).Value 
     
     '       Determine the file name
    SaveAsName = ThisWorkbook.Path & "\" & Request & ".doc" 
     
     '       Send commands to Word
    With WordApp 
        .Documents.Add 
        With .Selection 
            .Font.Size = 16 
            .Font.Bold = True 
            .Font.Underline = True 
            .ParagraphFormat.Alignment = 1 
            .TypeText Text:="INCORRECT/ADDITIONAL INFORMATION" 
            .TypeParagraph 
            .TypeParagraph 
            .TypeText message 
            .TypeParagraph 
            .TypeParagraph 
            .Font.Size = 12 
            .ParagraphFormat.Alignment = 0 
            .Font.Bold = False 
            .TypeText Text:="Date:" & vbTab & Date1 
            .TypeParagraph 
            .TypeText Text:="Analyst:" & vbTab & Analyst 
            .TypeParagraph 
            .TypeText Text:="Request:" & vbTab & Request 
            .TypeParagraph 
            .TypeText Text:="Region(s):" & vbTab & Regionpt50 
            .TypeParagraph 
            .TypeText Text:="Type:" & vbTab & Xx 
            .TypeParagraph 
            .TypeText Text:="Issue:" & vbTab & Issue 
            .TypeParagraph 
             
             
        End With 
        .ActiveDocument.SaveAs Filename:=SaveAsName 
    End With 
     
     '   Kill the object
    WordApp.Quit 
    Set WordApp = Nothing 
     
     '   Clear contents of DATA spreadsheet
    Sheets("DATA").Activate 
    Range("A2:L2").ClearContents 
    Unload UserForm1 
     'ThisWorkbook.Close True
End Sub

I snatched this from another site where the author was trying to accomplish the same thing. By this point, he was able to do nearly everything, but he did encounter an issue when clicking the button; it had to do with the ".ActiveDocument.SaveAs Filename:=SaveAsName" line. He apparently resolved it but never posted the final product, and the post is back from 2007. Anyone willing to help combine what I have posted with this code so that I could get a workable file?

[jaslake]

Hi tapsmiled

I believe Norie is correct, one cannot save a Userform. However, one can save an image of a Userform to an Excel File. Is this of interest?

[tapsmiled]

Private Sub CmdQASubmit_Click()

'here is the part you asked for
If ComboBox19.Text = "" Then
    MsgBox ("You must select an Operator's Name")

End If

If ComboBox20.Text = "" Then
    MsgBox ("You must select a Reviewer's Name")
    
    Exit Sub
End If


ROW_NUMBER = 0
Do
DoEvents
ROW_NUMBER = ROW_NUMBER + 1
item_in_review = Sheets("DATABASE").Range("A" & ROW_NUMBER)

    If item_in_review = ComboBox19.Text Then
        Sheets("DATABASE").Range("AG" & ROW_NUMBER) = ComboBox1.Text
        Sheets("DATABASE").Range("AH" & ROW_NUMBER) = ComboBox2.Text
        Sheets("DATABASE").Range("AI" & ROW_NUMBER) = ComboBox3.Text
        Sheets("DATABASE").Range("AJ" & ROW_NUMBER) = ComboBox4.Text
        Sheets("DATABASE").Range("AK" & ROW_NUMBER) = ComboBox5.Text
        Sheets("DATABASE").Range("AL" & ROW_NUMBER) = ComboBox6.Text
        Sheets("DATABASE").Range("AM" & ROW_NUMBER) = ComboBox7.Text
        Sheets("DATABASE").Range("AN" & ROW_NUMBER) = ComboBox8.Text
        Sheets("DATABASE").Range("AO" & ROW_NUMBER) = ComboBox9.Text
        Sheets("DATABASE").Range("AP" & ROW_NUMBER) = ComboBox10.Text
        Sheets("DATABASE").Range("AQ" & ROW_NUMBER) = ComboBox11.Text
        Sheets("DATABASE").Range("AR" & ROW_NUMBER) = ComboBox12.Text
        Sheets("DATABASE").Range("AS" & ROW_NUMBER) = ComboBox13.Text
        Sheets("DATABASE").Range("AT" & ROW_NUMBER) = ComboBox14.Text
        Sheets("DATABASE").Range("AU" & ROW_NUMBER) = ComboBox15.Text
        Sheets("DATABASE").Range("AV" & ROW_NUMBER) = ComboBox16.Text
        Sheets("DATABASE").Range("AW" & ROW_NUMBER) = ComboBox17.Text
        Sheets("DATABASE").Range("AZ" & ROW_NUMBER) = ComboBox20.Text
        Sheets("DATABASE").Range("BA" & ROW_NUMBER) = TextBox10.Text
        
    
  

  
  End If
  

    
    

    
Loop Until item_in_review = ""

ComboBox1 = ""
ComboBox2 = ""
ComboBox3 = ""
ComboBox4 = ""
ComboBox5 = ""
ComboBox6 = ""
ComboBox7 = ""
ComboBox8 = ""
ComboBox9 = ""
ComboBox10 = ""
ComboBox11 = ""
ComboBox12 = ""
ComboBox13 = ""
ComboBox14 = ""
ComboBox15 = ""
ComboBox16 = ""
ComboBox17 = ""
ComboBox18 = ""
ComboBox19 = ""



Dim resp

resp = MsgBox("Do you have any others to complete?", vbYesNo)
If resp = vbNo Then
    Unload Me
    
End If

End Sub

That is the code for the UserForm. What could I add to this to either save it as a PDF or save it to a Word Document? It is an Evaluation, and I would like to be able to go back and review it down the road. There will literally be hundreds of these completed.

[tapsmiled]

Possibly, but I am concerned about the amount of data that would require. There will, literally, be hundreds of these forms submitted a year, and saving all of them as images could take up a lot of space.

[jaslake]

Hi tapsmiled

Possibly, perhaps...you decide

I am concerned about the amount of data that would require

[jaslake]

Hi tapsmiled

The Code in the attached demonstrates how to save a Copy of a UserForm to PDF. I'm not certain where I got this Code. I do know the vast majority of it was provided by Leith Ross.

[tapsmiled]

Private Sub CmdQAPrint_Click()


  Dim myPath As String
  Dim strFile As String
  myPath = ThisWorkbook.Path & "/"
  strFile = Sheets(1).Name
  DoEvents
  keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
  keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
  keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
  keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
  DoEvents
  Workbooks.Add
  Application.Wait Now + TimeValue("00:00:01")
  ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
  ActiveSheet.PageSetup.Orientation = xlLandscape

  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                  myPath & strFile & ".pdf", Quality:= _
                                  xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                  OpenAfterPublish:=True
  Unload Me
  ActiveWorkbook.Close False
  OptionButton2.Value = False


End Sub

Thanks for the help. I tried it in the above code, but I received a compile error in the keybd_event section. I attached this to a Command Button, so perhaps that is causing the issue. Can anyone assist?

[jaslake]

Hi tapsmiled

If you will post your workbook with the UserForm and Code it'll be much easier to assist...

[tapsmiled]

Apparently, I was wrong.

Attached is the workbook. The form I am specifically working on (for this issue among a plethora of others) is the QA911 form PRINT button.

Be nice. I am a complete novice and am piecing things together as I go.

[jaslake]

Hi tapsmiled

See if this Code suffices for the Multi Page issue:

Private Sub cmdSaveAs_Click()
  Dim myPath As String
  Dim strfile As String
  Dim i As Long

  myPath = ThisWorkbook.Path & "/"
  strfile = Replace(Replace(Replace(Replace(Replace(Me.ComboBox19.Text & "_" & Now, "?", ""), "/", "_"), "*", ""), ":", "_"), " ", "_")

  For i = 0 To 1
    Me.MultiPage1.Value = i
    DoEvents
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    DoEvents
    Workbooks.Add
    Application.Wait Now + TimeValue("00:00:01")
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    With ActiveSheet
      .Range("A1").Select
    End With

    With ActiveSheet.PageSetup
      .Orientation = xlPortrait
      .FitToPagesWide = 1
      .FitToPagesTall = 1
    End With

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                    myPath & strfile & "_" & i & ".pdf", Quality:= _
                                    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=True
    ActiveWorkbook.Close False
  Next i
End Sub

and

Private Sub CmdQAPrint_Click()
  Dim i As Long
  Me.Hide
  frmQA.Hide
  For i = 0 To 1
    Me.Show vbModeless
    Me.MultiPage1.Value = i
    DoEvents
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    DoEvents

    Workbooks.Add
    Application.Wait Now + TimeValue("00:00:01")
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    With ActiveSheet
      .Range("A1").Select
    End With

    With ActiveSheet.PageSetup
      .Orientation = xlPortrait
      .FitToPagesWide = 1
      .FitToPagesTall = 1
    End With

    Me.Hide
    ActiveWindow.SelectedSheets.PrintPreview  'or PrintOut
    ActiveWorkbook.Close False
  Next i
  Me.Show
End Sub

[tapsmiled]

At the moment and after all of the time I have dedicated to this project, I am willing to go any route to accomplish what i need.

This is an employee database. The UserForms i want to save are evaluations. I would like to be able to access completed forms in the future (as PDF or whatever other method of saving them). We have hundreds of employees, and at minimum, 1 of these will be done/month for each employee.

So, to answer your question....I'll take what i can get for now.

[Norie]

What was the problem with ActiveDocument.SaveAs in the Word code?

Also, since you are already transferring the data to a worksheet could you not save that worksheet as a PDF?

The code for that is pretty straighforward, here's an example.

strFileName = ComboBox19.Value & "_911_" & Format(Date, "mm-dd-yyyy") & ".pdf"

    Sheets("SheetToSave").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:="C:\QA\" & strFileName, _
        Quality:=xlQualityStandard , IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False

[tapsmiled]

Transferring it to a worksheet is a last resort. I'm not proficient, I'm not getting the desired appearance, and I spent a considerable amount of time designing the form. But, if it's the only way, so be it. I won't be able to try for a day or 2. Regardless, thanks for your help!!

[Norie]

Your code already transfers the data to a worksheet.

Why is it a last resort?

On a worksheet you can apply formatting to the data to get it to look as you want, you can't do that with a userform.

[tapsmiled]

I would love to, but apparently the file is too large.

[jaslake]

Hi tapsmiled

Try zipping it.

[tapsmiled]

If I could get this to work perfectly, one click of a Command Button would save a copy of this Form into a specific folder (based upon the person that the QA is being completed) AND print the form so it could be signed and sent up the Chain of Command.

[tapsmiled]

Yes, if possible. I sent you a PM

[jaslake]

Hi tapsmiled

Do you want a PRINT and a SAVE Button or should they be combined?

You have a Multi-Page User Form...not sure how to deal with that...yet...

[tapsmiled]

I realize that the multi-page will be an issue, but there was no way around it unfortunately. I expected to put some type of message box alerting the user to print both pages of the form, but as you can tell, I have yet to tackle that. I don't mind separate buttons. The issue I ran into was that I boxes to go blank when the form is submitted, so it was impossible to print after submission. I'll take any solution I can find

[jaslake]

Hi tapsmiled

The attached File has embedded Code to both Print and Save to PDF the User Form frmQA911. I've yet to consider the Multi Page issue.

[tapsmiled]

And not to look a gift horse in the mouth, but is there a way to do it so that the toolbar at the bottom is not showing?

[tapsmiled]

Jaslake,
Thank you so much! When I try to print it though, I notice it is cutting off the right side of the form. It looks as if you made the form a bit narrower. Do I have to do that in order for the entire form to fit completely or is there a way to adjust the margins?

[jaslake]

Hi tapsmiled

Replace the Print Button Code with this

Private Sub CmdQAPrint_Click()
  Me.Hide
  frmQA.Hide
  Me.Show vbModeless
  DoEvents
  keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
  keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
  keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
  keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
  DoEvents

  Workbooks.Add
  Application.Wait Now + TimeValue("00:00:01")
  ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
  With ActiveSheet
    .Range("A1").Select
  End With

  With ActiveSheet.PageSetup
    .Orientation = xlPortrait
    .FitToPagesWide = 1
    .FitToPagesTall = 1
  End With

  Me.Hide
  ActiveWindow.SelectedSheets.PrintPreview  'or PrintOut
  ActiveWorkbook.Close False
  Me.Show
End Sub

Replace the Save Button Code with this

Private Sub cmdSaveAs_Click()
  Dim myPath As String
  Dim strfile As String
  myPath = ThisWorkbook.Path & "/"
  strfile = Replace(Replace(Replace(Replace(Replace(Me.ComboBox19.Text & "_" & Now, "?", ""), "/", "_"), "*", ""), ":", "_"), " ", "_")
  DoEvents
  keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
  keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
  keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
  keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
  DoEvents
  Workbooks.Add
  Application.Wait Now + TimeValue("00:00:01")
  ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
  With ActiveSheet
    .Range("A1").Select
  End With

  With ActiveSheet.PageSetup
    .Orientation = xlPortrait
    .FitToPagesWide = 1
    .FitToPagesTall = 1
  End With

  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                  myPath & strfile & ".pdf", Quality:= _
                                  xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                  OpenAfterPublish:=True
'  Unload Me
  ActiveWorkbook.Close False
End Sub

What are you referring to here?

the toolbar at the bottom is not showing

[tapsmiled]

I'll check. You are really awesome. Thanks!