Passing Info from Excel to Word

[underscorede]

Hello,

I have a VBA script in Excel where a user selects an image, then once the image is selected, and a command button is clicked, it triggers Microsoft Word to open.

Im having a problem and was hoping someone might be able to provide me with some help.

1st Problem - When the command button is clicked and Word is supposed to open i get a "Compiler Error, User Defined Type not defined"
Seems to be coming from the Dim oWord As Word.Application

Here is the script:

Private Sub CommandButton1_Click()
Dim fName As String
Dim i As Long
 
fName = Application.GetOpenFilename(filefilter:="Pictures (*.jpg,*.jpg", Title:="Open File(s)")
Me.TextBox1.Text = fName
 
End Sub
 
 
 
Private Sub CommandButton2_Click()
 
Dim strThisWorkbook As String
strThisWorkbook = ThisWorkbook.FullName
 
' create the word document:
Dim oWORD As Word.Application, wrdDoc As Word.Document, wrdTable As Word.Table
Set oWORD = New Word.Application
Set wrdDoc = oWORD.documents.Add
 
' so we can see what is happening in word:
oWORD.Visible = True
wrdDoc.Activate
 
' adjusting the page setup properties first:
    With wrdDoc.PageSetup
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(1.59)
        .BottomMargin = CentimetersToPoints(0)
        .LeftMargin = CentimetersToPoints(0.47)
        .RightMargin = CentimetersToPoints(0.47)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.25)
        .FooterDistance = CentimetersToPoints(1.25)
        .PageWidth = CentimetersToPoints(21)
        .PageHeight = CentimetersToPoints(29.7)
    End With
   
' creating the table of labels:
Set wrdRange = wrdDoc.Range
Set wrdTable = wrdDoc.Tables.Add(Range:=wrdRange, NumRows:=7, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
               wdAutoFitFixed)
 
' adjusting the table properties:
With wrdTable
        .Columns.PreferredWidth = CentimetersToPoints(9.9)
        .TopPadding = CentimetersToPoints(0)
        .BottomPadding = CentimetersToPoints(0)
        .LeftPadding = CentimetersToPoints(0.3)
        .RightPadding = CentimetersToPoints(0.3)
        .Rows.HeightRule = wdRowHeightExactly
        .Rows.Height = CentimetersToPoints(3.81)
        .Rows.Alignment = wdAlignRowCenter
        .Spacing = 0
        .AllowPageBreaks = True
        .AllowAutoFit = True
        .AutoFitBehavior (wdAutoFitFixed)
        .AutoFitBehavior (wdAutoFitFixed)
        .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        .Borders(wdBorderRight).LineStyle = wdLineStyleNone
        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
        .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
       .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
     End With
 
' getting the range of data from out excel data tabel:
Range(Rng("Sheet1")).Select
 
' propagate the data into your labels with a mail merge:
With oWORD.MailingLabel.Application.ActiveDocument
.mailmerge.MainDocumentType = wdMailingLabels
        ' choosing the right document and data table:
.mailmerge.OpenDataSource ThisWorkbook.FullName, ConfirmConversions = "False", ReadOnly = "False", LinkToSource = "True", AddToRecentFiles = "False", , , , , , , "Data Source=" & strThisWorkbook & ";Mode=Read", "SELECT * FROM `Sheet1$`"
.mailmerge.DataSource.ActiveRecord = wdFirstRecord
        ' iterating through each label:
        ' for each row (in excel):
    For r = 4 To .mailmerge.DataSource.RecordCount
        ' for each field (in excel):
        For f = .mailmerge.DataSource.DataFields.Count To 1 Step -1
          .Application.Selection = .mailmerge.DataSource.DataFields.Item(f).Value & vbCrLf
        Next f
        ' go to the next row (in excel):
      .mailmerge.DataSource.ActiveRecord = (r + 1)
        ' go to the next label (in word):
      .Application.Selection.MoveRight Unit:=wdCell
    Next r
        ' to be sure your data is visible:
.mailmerge.ViewMailMergeFieldCodes = wdToggle
End With
 
   
End Sub
 
Function Rng(Optional WorksheetName As String)
' the RNG range makes the range from A6 to C lastrow
    Dim LastRow As Integer
    Dim lastcol As String
    lastcol = "B"
        If WorksheetName = vbNullString Then
           WorksheetName = ActiveSheet.Name
        End If
    With Worksheets(WorksheetName)
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
       End With
        Rng = "A1:" & lastcol & LastRow
 
 
End Function
 
Private Sub CommandButton3_Click()
ActiveCell.Value = current_cell_value
UserForm1.Hide
End Sub

 

[Anusuya12]

Hi,

Press ALt+F11, Go to Tools > References. Scroll down to find "Microsoft Word 8" and check the box next to select this item.

This will enable the macro to trigger a word.

Let me know if this works!

 

[underscorede]

Hey,

For some reason Im getting an error, "Error accessing the system registry" - Im just fixing this issue, Ill let you know how it works.

Hi,

Press ALt+F11, Go to Tools > References. Scroll down to find "Microsoft Word 8" and check the box next to select this item.

This will enable the macro to trigger a word.

Let me know if this works!

 

[underscorede]

Hey bud, Im not seeing a Microsoft Word 8.0, the closest thing Im seeing is Microsoft Word 14.0 object library.

Im using Excel 2010. Let me know if there's something else i should click.

Thanks!

Hi,

Press ALt+F11, Go to Tools > References. Scroll down to find "Microsoft Word 8" and check the box next to select this item.

This will enable the macro to trigger a word.

Let me know if this works!

 

[underscorede]

Alright, just wanted to let you know. Its working.

However, when Word opens the table is formatted (as per the script), except no data from the Excel sheet (the Excel sheet contains names for the labels) is being passed onto the word document.

Any idea why that might be?

 

[underscorede]

Hey there,

So it works now...Im just getting a VBA Error, on this line
".Top Margin = CenitmetersToPoints(1.58)"

Any idea why that might be?

Private Sub UserForm_Click()
Private Sub CommandButton1_Click()
 
Dim strThisWorkbook As String
strThisWorkbook = ThisWorkbook.FullName
 
' create the word document:
Dim oWORD As Word.Application, wrdDoc As Word.Document, wrdTable As Word.Table
Set oWORD = New Word.Application
Set wrdDoc = oWORD.Documents.Add
 
' so we can see what is happening in word:
oWORD.Visible = True
wrdDoc.Activate
 
' adjusting the page setup properties first:
    With wrdDoc.PageSetup
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(1.58)
        .BottomMargin = CentimetersToPoints(0)
        .LeftMargin = CentimetersToPoints(0.47)
       .RightMargin = CentimetersToPoints(0.47)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.25)
        .FooterDistance = CentimetersToPoints(1.25)
        .PageWidth = CentimetersToPoints(21)
        .PageHeight = CentimetersToPoints(29.7)
    End With
   
' creating the table of labels:
Set wrdRange = wrdDoc.Range
Set wrdTable = wrdDoc.Tables.Add(Range:=wrdRange, NumRows:=7, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
               wdAutoFitFixed)
 
' adjusting the table properties:
With wrdTable
        .Columns.PreferredWidth = CentimetersToPoints(9.9)
        .TopPadding = CentimetersToPoints(0)
        .BottomPadding = CentimetersToPoints(0)
        .LeftPadding = CentimetersToPoints(0.3)
        .RightPadding = CentimetersToPoints(0.3)
        .Rows.HeightRule = wdRowHeightExactly
        .Rows.Height = CentimetersToPoints(3.81)
        .Rows.Alignment = wdAlignRowCenter
        .Spacing = 0
        .AllowPageBreaks = True
        .AllowAutoFit = True
        .AutoFitBehavior (wdAutoFitFixed)
        .AutoFitBehavior (wdAutoFitFixed)
        .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        .Borders(wdBorderRight).LineStyle = wdLineStyleNone
        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
        .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
     End With
 
' getting the range of data from out excel data tabel:
Range(Rng("Sheet1")).Select
 
' propagate the data into your labels with a mail merge:
With oWORD.MailingLabel.Application.ActiveDocument
.mailmerge.MainDocumentType = wdMailingLabels
        ' choosing the right document and data table:
.mailmerge.OpenDataSource ThisWorkbook.FullName, ConfirmConversions = "False", ReadOnly = "False", LinkToSource = "True", AddToRecentFiles = "False", , , , , , , "Data Source=" & strThisWorkbook & ";Mode=Read", "SELECT * FROM `Sheet1$`"
.mailmerge.DataSource.ActiveRecord = wdFirstRecord
        ' iterating through each label:
        ' for each row (in excel):
    For r = 4 To .mailmerge.DataSource.RecordCount
        ' for each field (in excel):
        For f = .mailmerge.DataSource.DataFields.Count To 1 Step -1
          .Application.Selection = .mailmerge.DataSource.DataFields.Item(f).Value & vbCrLf
        Next f
        ' go to the next row (in excel):
      .mailmerge.DataSource.ActiveRecord = (r + 1)
        ' go to the next label (in word):
      .Application.Selection.MoveRight Unit:=wdCell
    Next r
        ' to be sure your data is visible:
.mailmerge.ViewMailMergeFieldCodes = wdToggle
End With
 
   
End Sub
 
Function Rng(Optional WorksheetName As String)
' the RNG range makes the range from A6 to C lastrow
    Dim LastRow As Integer
    Dim lastcol As String
    lastcol = "C"
        If WorksheetName = vbNullString Then
           WorksheetName = ActiveSheet.Name
        End If
    With Worksheets(WorksheetName)
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
       End With
        Rng = "A6:" & lastcol & LastRow
End Function

Hi,

Press ALt+F11, Go to Tools > References. Scroll down to find "Microsoft Word 8" and check the box next to select this item.

This will enable the macro to trigger a word.

Let me know if this works!