Sub Create DOCX

Pinaceous

Well-known Member
Joined
Jun 11, 2014
Messages
1,107
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I'm using this sub to create a PDF from an Excel's worksheet.

It works really great!

Now, after careful review of my posted code below, is it possible to create a DOCX in lieu of the PDF?

I've tried to rearrange, modify, adjust, change this code to fit this DOCX creation, but I cannot.

Can someone please help me to change this code to produce a DOCX not a PDF??


Code:
Sub CreatePDF()

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", " ")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")
Select Case True
       
'export to PDF if a folder was selected
Case myFile <> "False"
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
      Exit Sub
            
 Case myFile <> "True"
    Application.CutCopyMode = False 'Clear Clipboard
        MsgBox "Not CREATING PDF!!"
        Exit Sub
  End Select
    Exit Sub
exitHandler:
    Exit Sub
    
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
            
End Sub

Many thanks in advance.

Respectfully,
Pinaceous
 
Last edited:
I've modified the code in post 4 slightly. It now leaves the Word session visible with your newly-created document open. You'll note two commented-out lines, too. Uncomment those and the documents will be closed and the Word session exited.
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
I've modified the code in post 4 slightly. It now leaves the Word session visible with your newly-created document open. You'll note two commented-out lines, too. Uncomment those and the documents will be closed and the Word session exited.


Hello Micropod,

That is really fantastic!

Thank you for modifying the code in post 4. That is really fantastic!

I'm trying to figure out where in you code I can change the name of the docx?

For example, in lieu of the name "TEST" as the created file name; can you adjust the code to produce:
"ActiveSheet Name" And "yyyymmdd\_hhmm".docx'
As its File Name??

Thanks again!!
Pinaceous
 
Last edited:
Upvote 0
Change:
FlNm = Split(.FullName, ".xls")(0) & ".docx"
to:
FlNm = .Path & "" & ActiveSheet.Name & " " & Format(Now,"YYYYMMDD_hhmm") & ".docx"
 
Last edited:
Upvote 0
Hi Macropod,

Thank you for clearing that up!

Let me give it a go!

Thanks,
Pinaceous
 
Upvote 0
Hello Macropod,

I am wondering, if in following my original post#1 code proposal, if you can have the created word file "not open" and to "save it in a location" according to:

Code:
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="Microsoft Word Document Files (*.docx), *.docx", _
        Title:="Select Folder and FileName to save")

Is this possible to seed this into your code (?)

I'm trying different ways, but I cannot see myself through this situation.

Please help me, if you can.

Many thanks,
Pinaceous
 
Last edited:
Upvote 0
As indicated in post 11, if you uncomment the two commented-out lines, Word will close the file and exit. If you also change:
.Visible = True
to:
.Visible = False
you'll never even see the Word session running. As for allowing an optional save name, you could replace:
.SaveAs Filename:=FlNm, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
with:
Code:
    With wdApp.Dialogs(wdDialogFileSaveAs)
      .Name = FlNm
      .AddToMRU = False
      .Show
    End With
 
Upvote 0
Hello Macropod,
Thank you for explaining to me how & what to do. Appreciate it!
The code works really works good now.
However, when I go to open the created word document (DOCX), I get the following error message, which is similar to what I've experienced to the (XLSM) in post#10.

File In Use
Destop Test1 YYYMMDD_
is locked for editing by 'Authorized user'.
Do you want to:
*Open a Read Only copy
*Create a local copy and merge your changes later
* Receive notification when the original copy is available



But; how do I fix this??

I'm thinking that I need to do something similar like the reference fix I've performed inside the XLSM or with the DOCX(?)

Please help me if you can.
Thank you!
Pinaceous
 
Last edited:
Upvote 0
Hi Macropod,

I don't really know, but I've restarted the computer and ran the code again and it appears that it is working without any hiccups on opening the newly created word docx.

Here is the code, just in case ...


Code:
Sub Excel_to_Word()
'Note: This code requires a reference to the Word Object Library to be set.
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim xlRng As Excel.Range, r As Long, c As Long, FlNm As String
With ActiveWorkbook
  FlNm = ActiveSheet.Name & " " & Format(Now, "YYYYMMDD_hhmm") & ".docx"
  With .ActiveSheet
    With .UsedRange.Cells.SpecialCells(xlCellTypeLastCell)
      r = .Row
      c = .Column
    End With
    Set xlRng = .Range(.Cells(1, 1), .Cells(r, c))
  End With
End With
With wdApp
  .Visible = False
  Set wdDoc = .Documents.Add
  xlRng.Copy
  With wdDoc
    .Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
    '.SaveAs Filename:=FlNm, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
      With wdApp.Dialogs(wdDialogFileSaveAs)
      .Name = FlNm
      .AddToMRU = False
      .Show
    End With
    '.Close False
  End With
  '.Quit
End With
Application.CutCopyMode = False
Set xlRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing
End Sub


.. you see something here that needs a tweak (?), please do so. I am guessing it was my computer.

Many thanks for all of your help and assistance.

Respectfully,
Pinaceous
 
Last edited:
Upvote 0
You haven't done as suggested in post 11 -
.Close False
and
.Quit
are both still commented-out!
 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,024
Members
448,543
Latest member
MartinLarkin

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
Back
Top