时间戳

首页 > 解决方案 > 如何填充表格的其他部分

vba - 如何填充表格的其他部分

问题描述

我在单元格 A1 19,200、B1 13/05/2020 和单元格 C1 72 中有。当我执行 VBA 时，会在 Word 中创建一个表格，如下所示，它继续到 72

Instal No   Amt(Rs) Due Date    Instal No   Amt(Rs) Due Date
1   19200   13/05/2020          
2   19200   13/06/2020          
3   19200   13/07/2020          
4   19200   13/08/2020          
5   19200   13/09/2020          
6   19200   13/10/2020          
7   19200   13/11/2020          
8   19200   13/12/2020          
9   19200   13/01/2021          
10  19200   13/02/2021          
11  19200   13/03/2021          
12  19200   13/04/2021          
13  19200   13/05/2021          
14  19200   13/06/2021          
15  19200   13/07/2021          
16  19200   13/08/2021

请注意，C1 是月数（即安装号）。

我想要实现的是填写表格空白右侧的另一部分。让我澄清一下如果 C1 = 72 个月，然后将其分成一半，即发送 36 个月到表格的另一边。我的月数是偶数（24,36,48,60,98）

您会注意到，由于标题，我已将 1 添加到“lngRows = Range("C1").Value + 1”

我的代码如下： -

Sub CreateTableInWord()
Dim objWord As Object
Dim objDoc As Object
Dim objTbl As Object
Dim objRow As Object
Dim objCol As Object
Dim lngCols As Long
Dim lngRows As Long
Dim I As Long

    lngCols = 6
    lngRows = 72

    Set objWord = CreateObject("Word.Application")

    objWord.Visible = True

    Set objDoc = objWord.Documents.Add(DocumentType:=0)

    Set objTbl = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, NumRows:=lngRows, NumColumns:=lngCols)

    Set objRow = objTbl.Rows(1)


   objTbl.Cell(1, 1).Range.Text = "Instal No"
   objTbl.Cell(1, 1).Range.Bold = True
   objTbl.Cell(1, 2).Range.Text = "Amt(Rs)"
   objTbl.Cell(1, 2).Range.Bold = True
   objTbl.Cell(1, 3).Range.Text = "Due Date"
   objTbl.Cell(2, 3) = Range("B1").Value
   objTbl.Cell(1, 3).Range.Bold = True
   objTbl.Cell(1, 4).Range.Text = "Instal No"
   objTbl.Cell(1, 4).Range.Bold = True
   objTbl.Cell(1, 5).Range.Text = "Amt(Rs)"
   objTbl.Cell(1, 5).Range.Bold = True
   objTbl.Cell(1, 6).Range.Text = "Due Date"
   objTbl.Cell(1, 6).Range.Bold = True
   objTbl.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    For I = 2 To lngRows

    ' For j = 1 To intNoOfColumns

  objTbl.Cell(I, 1).Range = I - 1

     Next

   For S = 2 To lngRows

  objTbl.Cell(S, 2) = Range("A1").Value

    Next

For T = 2 To lngRows

objTbl.Cell(T, 3).Range.Text = Format(DateAdd("m", T - 2, Range("B1").Value), "dd/mm/yyyy")
Next T




    Set objCol = Nothing

    Set objRow = Nothing

    Set objDoc = Nothing

    Set objWord = Nothing

End Sub

标签： vbams-word

解决方案

试试这个：

Sub CreateTableInWord()

    Dim objWord As Object, objDoc As Object, objTbl As Object, objRow As Object
    Dim objCol As Object, colSets As Long, numMonths As Long, i As Long, n As Long, c As Long
    Dim amt, dtStart, tblRows As Long, tblCols As Long, rw As Long, col As Long

    numMonths = Range("A1").Value
    amt = Range("B1").Value
    dtStart = Range("C1").Value
    colSets = Range("D1").Value 'how many sets of columns ?

    tblRows = 1 + Application.Ceiling(numMonths / colSets, 1) 'how many table rows?
    tblCols = colSets * 3                                     'how many table cols?

    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    Set objDoc = objWord.Documents.Add(DocumentType:=0)
    Set objTbl = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, _
                 NumRows:=tblRows, NumColumns:=tblCols)

    c = 0
    For n = 1 To colSets
        objTbl.Cell(1, c + 1).Range.Text = "Instal No"
        objTbl.Cell(1, c + 1).Range.Bold = True
        objTbl.Cell(1, c + 2).Range.Text = "Amt(Rs)"
        objTbl.Cell(1, c + 2).Range.Bold = True
        objTbl.Cell(1, c + 3).Range.Text = "Due Date"
        objTbl.Cell(1, c + 3).Range.Bold = True
        c = c + 3
    Next n
    objTbl.Range.ParagraphFormat.Alignment = 1 ' wdAlignParagraphCenter

    rw = 2
    col = 0
    For i = 1 To numMonths

        'rw = 1 + Application.Ceiling(i / colSets, 1)  'fill across and then down
        rw = IIf(i Mod (tblRows - 1) = 1, 2, rw + 1)   'fill down then across

        objTbl.Cell(rw, col + 1).Range.Text = i
        objTbl.Cell(rw, col + 2).Range.Text = amt
        objTbl.Cell(rw, col + 3).Range.Text = DateAdd("m", i - 1, dtStart)

        'col = IIf(i Mod colSets = 0, 0, col + 3)         'fill across and then down
        col = IIf(i Mod (tblRows - 1) = 0, col + 3, col) 'fill down and then across

    Next i

End Sub

推荐阅读