Wendy Velasquez
Wendy Velasquez

Reputation: 181

Copying an Excel WorkSheet with Activex Controls and customizing inside the word document using VBA

I'm working on a template document layout in Excel that has multiple dropdowns boxes and textboxes, checkboxes. Here is the thing the document has multiple lists data validations and those other controls.

I'm able to paste the document with the data validation lists values, and I'm trying to get the values of the ativex control to be reflected in the word document as well as fitting the content properly within the margins of the word document. So far this is the code I have:

 Sub GenerateWordDoc()
 
     ' creates and initializes a word application object
     Dim WordApp As Object
     Set WordApp = CreateObject("Word.Application")
    
     'Makes it visible and adds the blank page into the word app
      WordApp.Visible = True
      WordApp.Activate
      WordApp.Documents.Add
    
     'selects the range that I want to copy
      Range("A1:J52").Copy
    
      'paste the data selected in Excel into the word doc created
       WordApp.Selection.Paste   
      'Saves the file
       WordApp.ActiveDocument.SaveAs2 Environ("userprofile") & "FIlePathTest " &             
      Format(Now, "yyyy-mm-dd hh-mm-ss") & ".docx"
       
      'Closes the app
       WordApp.ActiveDocument.Close
    
      'quits the app
       WordApp.Quit
   End Sub

and I have been using the following commands to fit the data in the word document

    Dim WordTable As Object
    Set WordTable = WordApp.Tables(1)
    WordTable.AutoFitBehavior (wdAutoFitContent)   '2

and

    Set objDoc = objWord.Documents.Add    
    'Paste Table into MS Word
     objDoc.Range.PasteExcelTable _
          LinkedToExcel:=False, _
          WordFormatting:=False, _
          RTF:=False
        
    'Autofit Table so it fits inside Word Document
     Dim WordTable As Object
     Set WordTable = objDoc.Tables(1)
     WordTable.AutoFitBehavior (wdAutoFitWindow)

for the dropdown boxes, I have this code(note.- this is only one method)

 Sub dropdownVariable2()
     Dim dd2 As DropDown
     Dim ddval As Variant
     Set dd2 = ActiveSheet.Shapes("Drop Down 56").OLEFormat.Object
     ddval = dd2.List(dd2.ListIndex)
 End Sub

Can someone please advice/help mainly in the very first method I posted. I don't know if it is because the document is not a table. Although Word recognizes the paste as a table.

Upvotes: 0

Views: 182

Answers (1)

macropod
macropod

Reputation: 13515

For example:

Sub GenerateWordDoc()
Dim ObjWrd As Object, ObjDoc As Object

'Initializes Word
Set ObjWrd = CreateObject("Word.Application")
With ObjWrd
  .Visible = True
  
  'Create a Document
  Set ObjDoc = .Documents.Add
  
  'Copy the Excel Range
  Range("A1:J52").Copy

  With ObjDoc
    'Paste the Excel data into the Document
    .Range.Paste
    
    'Format the Table
    With .Tables(1)
      .AllowAutoFit = True
      .AutoFitBehavior 2 'wdAutoFitWindow
    End With
    
    'Save and close the Document
    .SaveAs Environ("UserProfile") & "FilePathTest " & Format(Now, "yyyy-mm-dd hh-mm-ss") & ".docx", _
      12, , , False '12 = wdFormatXMLDocument
    .Close False
  End With
  
  'Quit Word
  .Quit
End With
End Sub

However, your use of Word constants in your code suggests you've set a reference to Word. In that case, you're already set to use early binding, which is much faster. With early binding you could use:

Sub GenerateWordDoc()
Dim WrdApp As New Word.Application, WrdDoc As Word.Document

With WrdApp
  .Visible = True
  
  'Create a Document
  Set WrdDoc = .Documents.Add
  
  'Copy the Excel Range
  Range("A1:J52").Copy

  With WrdDoc
    'Paste the Excel data into the Document
    .Range.PasteExcelTable False, False, False
    
    'Format the Table
    With .Tables(1)
      .AllowAutoFit = True
      .AutoFitBehavior wdAutoFitWindow
    End With
    
    'Save and close the Document
    .SaveAs Filename:=Environ("UserProfile") & "FilePathTest " & Format(Now, "yyyy-mm-dd hh-mm-ss") & ".docx", _
      FileFormat:=wdFormatXMLDocument, AddTorecentFiles:=False
    .Close False
  End With
  
  'Quit Word
  .Quit
End With
End Sub

Upvotes: 1

Related Questions