Option Explicit

Sub sPrintTable()

Dim labelrows, labelcolumns, i As Integer
Dim j As Integer, k As Integer, t As Integer
Dim rsRows As Integer
Dim rs As ADODB.Recordset, rsCount As ADODB.Recordset
Dim cn As ADODB.Connection
Dim sqlGetTbl As String
Dim sDataSource As String, sDataTable As String
Dim sProvider As String

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rsCount = New ADODB.Recordset

sDataSource = "C:\MS Access\Database3.accdb"
sDataTable = "qrySalesPersonYTD"

sProvider = "Microsoft.ACE.OLEDB.12.0;"
sDataSource = "'" & sDataSource & "'"

If InStr(1, sDataSource, ".xlsx") = 0 And InStr(1, sDataSource, ".accdb") = 0 Then
   MsgBox "Please use only Excel or Access Data Source formats.", vbExclamation
   Exit Sub
End If
If (InStr(1, sDataSource, ".xlsx") > 0) Then
   sDataSource = sDataSource & ";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1';"
   sDataTable = "[" & sDataTable & "$]"
End If

If Len(sProvider) > 0 And Len(sDataSource) > 0 Then
cn.Provider = sProvider
cn.ConnectionString = "Data Source=" & sDataSource
cn.Open
 
 sqlGetTbl = "SELECT COUNT([Sales ID]) FROM " & sDataTable
 rsCount.Open sqlGetTbl, cn, adOpenDynamic, adLockOptimistic
  
  sqlGetTbl = "SELECT * FROM " & sDataTable
  rs.Open sqlGetTbl, cn, adOpenDynamic, adLockOptimistic
Else
  MsgBox "Data Source and Table must be provided.", vbExclamation
  Exit Sub
End If

labelrows = rsCount.Fields(0)

labelcolumns = 3
 
If Len(labelcolumns) > 0 And Len(labelrows) > 0 Then
 ActiveDocument.PageSetup.HeaderDistance = InchesToPoints(0.5)
 ActiveDocument.PageSetup.FooterDistance = InchesToPoints(0.5)
 ActiveDocument.PageSetup.LeftMargin = InchesToPoints(0.75)
 ActiveDocument.PageSetup.RightMargin = InchesToPoints(0.75)
 Selection.WholeStory
 Selection.Delete
  
 Selection.Font.Bold = True
 Selection.Font.Name = "Times New Roman"
 Selection.TypeText Text:="Sales Year to Date"

 Selection.TypeText Text:=Chr(11) & "For the Year 2017"
 Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
  Selection.ParagraphFormat.LineUnitAfter = 1

 Selection.Font.Bold = False
 Selection.TypeText Text:=vbCr & "The Sales Representatives are:"
 Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
 Selection.ParagraphFormat.LineUnitAfter = 1
    
 Selection.TypeParagraph
 Selection.Font.Name = "Times New Roman"
 Selection.Font.Size = "9"
 Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
 Selection.Font.Bold = False
 
   
 t = 0
 t = t + 1
 
  If Not rs.EOF Then
     ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=labelrows + 1, NumColumns:= _
       labelcolumns, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
     ActiveDocument.Tables(t).Columns.PreferredWidth = InchesToPoints(5)
     ActiveDocument.Tables(t).Columns(2).PreferredWidth = InchesToPoints(10)
     ActiveDocument.Tables(t).Columns(3).PreferredWidth = InchesToPoints(10)
     
     ActiveDocument.Tables(t).Rows.Height = InchesToPoints(0.3)
     ActiveDocument.Tables(t).Borders(wdBorderLeft).Visible = True
     ActiveDocument.Tables(t).Borders(wdBorderRight).Visible = True
     ActiveDocument.Tables(t).Borders(wdBorderTop).Visible = True
     ActiveDocument.Tables(t).Borders(wdBorderBottom).Visible = True
     ActiveDocument.Tables(t).Borders(wdBorderHorizontal).Visible = True
     ActiveDocument.Tables(t).Borders(wdBorderVertical).Visible = True
  End If
  
i = 1
j = 1

If Not rs.EOF And Not IsNull(rs.Fields(1)) Then
 For j = 1 To labelrows
 
  For k = 1 To labelcolumns

  If j = 1 Then
           
     ActiveDocument.Tables(t).Cell(j, k).Range.InsertBefore rs.Fields(k - 1).Name
     ActiveDocument.Tables(t).Cell(j, k).Range.Shading.BackgroundPatternColor = wdColorGray15
     ActiveDocument.Tables(t).Cell(j, k).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
      
     ActiveDocument.Tables(t).Cell(j + 1, k).Range.InsertBefore rs.Fields(k - 1)
     
      Selection.EndOf Unit:=wdParagraph, Extend:=wdExtend
      Selection.Range.Font.Bold = True
      Selection.Range.Font.Underline = wdUnderlineSingle
      
  Else
    If Len(Trim(rs.Fields(k - 1))) > 0 Then
      ActiveDocument.Tables(t).Cell(j + 1, k).Range.InsertBefore rs.Fields(k - 1)
    
    End If
      
  End If
  
      Select Case k
        Case 3:
         ActiveDocument.Tables(t).Cell(j + 1, k).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        Case 1, 2:
         ActiveDocument.Tables(t).Cell(j + 1, k).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
      
      End Select
      
    Next k
    rs.MoveNext
 Next j
 
End If

 If Not rs.EOF Then
  rsRows = ActiveDocument.Paragraphs.Count
  Selection.Move Unit:=wdParagraph, Count:=rsRows
  Selection.InsertBreak Type:=wdPageBreak
 End If

  rs.Close
  cn.Close

  Selection.MoveDown Unit:=wdLine, Count:=labelrows + 2
  Selection.TypeParagraph

End If

End Sub