Create (word) User form for signature and date using excel VBA

AawwYeahh

New Member
Joined
Aug 10, 2017
Messages
33
Ok I am stymied. Please help!
I have gotten code to:
Open word
Open template
Copy cells (from excel)
Paste cells into word

HOWEVER
I want to create name for word document (cell A92 in excel)
Save word document as filename (cell A92 in excel)
As .doc
In folder C:\MidSouth\PENDING

Lock all cells against editing
EXCEPT one cell for signature (in excel cell is A85)
AND one cell for date (in excel cell is G85)

Then close document.



Here is my current code:

File-Copy-icon.png

Sub CreateWordReport()
Dim WordApp As Word.Application
Set WordApp = New Word.Application

With WordApp
.Visible = True
.Activate
.Documents.Open ("C:\Mem1\Custom Office Templates\Installation Agreement.docm")

Sheets("Contract").Unprotect Password:=""
Range("A1:G92").Select
Selection.Copy
.Selection.Paste

Crossposted at https://www.excelguru.ca/forums/show...sing-excel-VBA
 

AawwYeahh

New Member
Joined
Aug 10, 2017
Messages
33
MACROPOD....YOU ARE AWESOME!!!!!!!!!!
After a few tweaks was able to get code create locked populated contract!
(One more request...I Know I know I am pushing it at this point)
I currently have code that will let me create folder/filename based on cell value
I have tried (unsucessfully) to integrate this idea into my new contract idea so that I could save contract directly to client folder vs. parent folder
Here is a copy
VBA Code:
Sub FileFolder()
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
Worksheets("Dashboard").Select
strDirname = Range("A4").Value ' New directory name

strFilename = Range("Q12").Value 'New file name
strDefpath = "C:\MidSouth\PENDING\" 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub

MkDir strDefpath & strDirname
strPathname = strDefpath & strDirname & "\" & strFilename 'create total string

ActiveWorkbook.SaveAs filename:=strPathname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

and here is a copy of current working contract code

VBA Code:
Sub CreateContract()
Dim wdApp As New Word.Application, wdDoc As New Word.Document, xlSht As Excel.Worksheet
Set xlSht = ActiveWorkbook.Sheets("CONTRACT")
With wdApp
  Application.Visible = True
  Set wdDoc = .Documents.Add(Template:="C:\MemphisCAC\Custom Office Templates\Installation Agreement.dotx")
  With wdDoc
    xlSht.Range("A1:G93").Copy
    .Range.Characters.Last.Paste
    With .Tables(.Tables.Count)
      .Cell(92, 3).Range.Editors.Add wdEditorEveryone
      .Cell(92, 5).Range.Editors.Add wdEditorEveryone
    End With
    .Protect Password:="", Type:=wdAllowOnlyReading
    .SaveAs filename:="C:\MidSouth\PENDING\" & xlSht.Range("A93").Text & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    .Close False
  End With
  .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing: Set xlSht = Nothing
End Sub

thoughts on this idea?
Again, Man you are AWESOME (Thanks so much for your patience!)
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,637
If you re-wrote FileFolder as a Function, it could return strDirname for use in your .SaveAs line:
VBA Code:
Function FileFolder(strDirname) As String
Const strDefpath As String = "C:\MidSouth\PENDING\" 
If Dir(strDirname, vbDirectory) = "" Then MkDir strDirname
FileFolder = strDefpath  & strDirname & "\"
End Function

VBA Code:
.SaveAs filename:=FileFolder(Worksheets("Dashboard").Range("A4").Value) & xlSht.Range("A93").Text & ".docx", _
        FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
 

AawwYeahh

New Member
Joined
Aug 10, 2017
Messages
33
Have run into something trying to implement code when I attempt to run the (createcontract) we had previously built or my (workingcontract ) that I am trying to implement said suggestions into. I receive this (not the pink bar). BTW I went looking for this folder...it does not seem to exist
 

Attachments

  • Screenshot 2022-07-03 111300.jpg
    Screenshot 2022-07-03 111300.jpg
    107.6 KB · Views: 1

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,637
Function revision:
VBA Code:
Function FileFolder(strDirname) As String
Const strDefpath As String = "C:\MidSouth\PENDING\"
strDirname = strDefpath & strDirname
If Dir(strDirname, vbDirectory) = "" Then MkDir strDirname
FileFolder = strDirname & "\"
End Function
 
Solution

AawwYeahh

New Member
Joined
Aug 10, 2017
Messages
33
Function revision:
VBA Code:
Function FileFolder(strDirname) As String
Const strDefpath As String = "C:\MidSouth\PENDING\"
strDirname = strDefpath & strDirname
If Dir(strDirname, vbDirectory) = "" Then MkDir strDirname
FileFolder = strDirname & "\"
End Function
THANK YOU FOR YOUR HELP!!!! THIS WORKS LIKE A CHARM!!!!
 

Forum statistics

Threads
1,176,103
Messages
5,901,398
Members
434,890
Latest member
creativimama

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top