Sub Create DOCX

Pinaceous

Well-known Member
Joined
Jun 11, 2014
Messages
1,124
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:

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
The basic code would be something like:
The above code simply copies the active sheet, pastes it as a table into a new Word document, then saves that document with the same path & name as the workbook. Modify to suit your requirements, which might include adjusting the page size & margins and/or having to introduce a nested loop to paste different Excel ranges to different Word pages - if the content won't all fit on one page.

Macropod,
I hope that you are not too surprised that I am now asking you about this part of your post as I evolve with this learning topic for me. I am discovering that what I read here I am now experiencing anew.

If I were to modify my requirements to include adjusting the page size & margins, where would this go?

I’ve create a sub from through the Page Layout through the Print Titles to affect the scaling of the Excel’s active sheet that I’m going to posting here:

Code:
Sub Macro1()
'
' Macro1 Macro
'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$J$41"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = False
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    
End Sub

I’ve tried to place
Code:
 Call Macro1
in various places of the Sub Excel_to_Word() to see how it affects the created DOCX document scaling parameters but what I attempt here, is not changing it at all.
If there is a code through your words:

Modify to suit your requirements, which might include adjusting the page size & margins and/or having to introduce a nested loop to paste different Excel ranges to different Word pages - if the content won't all fit on one page.

What would it look like and where would it go??

Please let me know, only when you can.

Thank you for coaching and mentoring stance in helping me on this topic.

Respectfully,
Pinaceous
 
Last edited:
Upvote 0
Your additional Excel code is irrelevant - it's the Word document you need to modify, using Word's own code. Thus, after:
With wdDoc
you might insert something like:
Code:
    With .PageSetup
      .PaperSize = wdPaperLetter
      .Orientation = wdOrientLandscape
      .LeftMargin = wdApp.InchesToPoints(0.25)
      .RightMargin = wdApp.InchesToPoints(0.25)
      .TopMargin = wdApp.InchesToPoints(0.25)
      .BottomMargin = wdApp.InchesToPoints(0.25)
    End With
Note that I've set all margins to 1/4in; Word is likely to complain otherwise unless you're using a printer that does full-page bleeds.
 
Upvote 0
Your additional Excel code is irrelevant - it's the Word document you need to modify, using Word's own code. Thus, after:
With wdDoc
you might insert something like:
Code:
    With .PageSetup
      .PaperSize = wdPaperLetter
      .Orientation = wdOrientLandscape
      .LeftMargin = wdApp.InchesToPoints(0.25)
      .RightMargin = wdApp.InchesToPoints(0.25)
      .TopMargin = wdApp.InchesToPoints(0.25)
      .BottomMargin = wdApp.InchesToPoints(0.25)
    End With
Note that I've set all margins to 1/4in; Word is likely to complain otherwise unless you're using a printer that does full-page bleeds.


Hey Macropd,

Code working really great!

I've only changed the orientation to
Code:
 .Orientation = wdOrientPortrait
with success.

I've tried to change the
Code:
 Right Margin
to various numbers but I cannot move it over to justify the print. The data range is off the screen, every time.

If my excel range is
Code:
 ActiveSheet.PageSetup.PrintArea = "$A$1:$K$41"
is up to Column K, how do I add this to the code?

I am hoping that adding this to the existing code it will help me with my printing range.

Many thanks,
Paul
 
Upvote 0
I've tried to change the
Code:
 Right Margin
to various numbers but I cannot move it over to justify the print. The data range is off the screen, every time.
So what is the range that's actually being copied & pasted into Word and how wide is that range?
If my excel range is
Code:
 ActiveSheet.PageSetup.PrintArea = "$A$1:$K$41"
is up to Column K, how do I add this to the code?
You don't. As I'd have thought was clear by now, anything of this nature you specify in Excel is irrelevant where Word is concerned.
 
Upvote 0
Hi Macropod,

I got it! I shrunk the columns disproportionately until it came out normal for word.

Many thanks for all of your help!

Paul
 
Upvote 0
Hey Macropod!

Everything is working out great!

I just have a question with the dialogue box.

If the user choses to "cancel" the saveas doc. how can I then conclude in the code 'Exit Sub' for that case?

Many thanks,
Pal
 
Upvote 0
Macropod!

I am enthralled over your knowledge.

I stand humble and I thank you.

Cheers Paul!
 
Upvote 0
Hello Macropod,



In using the code:

Code:
'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 = True
  Set wdDoc = .Documents.Add
  xlRng.Copy
  With wdDoc
        With .PageSetup
      .PaperSize = wdPaperLetter
      .Orientation = wdOrientPortrait
      .LeftMargin = wdApp.InchesToPoints(0)
      .RightMargin = wdApp.InchesToPoints(0.25)
      .TopMargin = wdApp.InchesToPoints(0.25)
      .BottomMargin = wdApp.InchesToPoints(0.45)
        End With
    .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
   Exit Sub



I've encountered a slight problem with the way that the Microsoft save dialog icon alerts the user, whereby I get only an irritating flash of the main window's title bar and the application's button the taskbar.



I've trying to 'Force the
Code:
 wdDialogFileSaveAs
to the front of the excel window, to help properly notify the user, where I've tried a slew of codes and functions with no promise.


Do you have a Function &/or an additional line to add to the code to make the
Code:
 wdDialogFileSaveAs
pop out in front of the Excel window as opposed to the irritating flash alerting to the user upon the taskbar??



Thank for your continued help and support!!
Paul
 
Upvote 0

Forum statistics

Threads
1,223,710
Messages
6,174,019
Members
452,542
Latest member
Bricklin

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