VBA wps 插入

Sub TraverseSelectedCells()
    Dim selectedCells As Cells
    Dim cell As cell
    Dim cellText As String
    Dim dataArray() As Variant
    Dim i As Long
    Dim tmp As Long
    Dim num_count As Long

    ' 获取选中的单元格
    Set selectedCells = Selection.Cells
    
    
    tmp = 0
    num_count = 0
    i = 1
    
    
    
    ' 遍历选中的单元格
    For Each cell In selectedCells
        ' 计算单元格数量
        num_count = num_count + 1
    Next cell
    
    
    
    ' MsgBox num_count
    
    ' 设置数组长度
    ReDim dataArray(1 To num_count)
    
    ' 遍历选中的单元格
    For Each cell In selectedCells
        ' 存取单元格内容
        Set CellRange = cell.Range
        CellRange.End = CellRange.End - 1
        cellText = Trim(CellRange.Text)
        tmp = Val(cellText)
        dataArray(i) = tmp
        ' MsgBox i
        i = i + 1
    Next cell
    
    
    
    ' MsgBox num_count
    ' MsgBox dataArray(2)
    
    ' 升序排列数组
    SortArrayAscending dataArray
    
    ' 弹出消息框显示排序后的数组内容
    MsgBox Join(dataArray, ", ")
    
    ' 创建单元格
    AddRowToSelectedTable num_count
    
    '调节单元格比例，目前只是调节一次
    SelectRowOfSelectedCell
    
    
    
    
    
    
End Sub


Sub SortArrayAscending(ByRef arr() As Variant)
    Dim i As Long
    Dim j As Long
    Dim temp As Variant
    
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

Sub AddRowToSelectedTable(cell_count As Long)
    Dim selectedTable As Cells
    Dim selectedCell As cell
    Dim lastRow As Object
    Dim cellToMerge As Cells
    Dim newCells As Range
    Dim select_Cell As Cells
    Dim row As Long
    
    ' MsgBox Selection.Type
    ' 检查是否有选中的单元格
    If Selection.Type = 4 Then
        ' 获取选中的单元格对象
        Set selectedCell = Selection.Cells(1)
        
        ' 获取选中单元格所在的表格对象
        Set selectedTable = selectedCell.Tables.Parent.Column.Cells
        
        Dim i As Long
        
        i = selectedTable.Count
        MsgBox i
        
        ' 获取表格的最后一行
        Set lastRow = selectedTable(i)
        
        ' 在表格的最后一行添加一行
        lastRow.Select
        Selection.InsertRowsBelow
        Set select_Cell = Selection.Cells
        
        select_Cell.Merge
        
        
        ' 设置新行的列数为4
        ' With Selection.Tables(1)
        '    .Columns.Add
        '    .Columns.Add
        '    .Columns.Add
        ' End With
        
        ' 计算生成几行，通过判断单元格个数是奇数或者偶数
        Dim count_rows As Long
        count_rows = cell_count \ 2
        ' 拆分单元格
        If cell_count Mod 2 = 0 Then
            
        
            select_Cell.Split NumRows:=count_rows, NumColumns:=4
        Else
            count_rows = count_rows + 1
            select_Cell.Split NumRows:=count_rows, NumColumns:=4
        ' 提示添加成功
        End If
    MsgBox "行已成功添加到选中的表格的最后一行，并且包含" & count_rows & "列。"
    Else
        ' 如果没有选中单元格，则提示错误
        MsgBox "请先选中一个单元格。"
    End If
End Sub

' 这里是分段
' 调节行距和间距
Function SelectRowOfSelectedCell() As Variant



    Dim SelectionRow As Object
    Dim selectedCells As Cells
    Dim c As cell
    Dim index As Long
    Dim percent As Single
    
    
    
    
    Set SelectionRow = Selection.Rows(1)
    SelectionRow.Select
    
    Set selectedCells = Selection.Cells
    index = selectedCells.Count
    
    
    
    For Each c In selectedCells
        ' MsgBox c.PreferredWidthType
        ' 设置列宽形式为百分比
        c.PreferredWidthType = wdPreferredWidthPercent
        
        
        
        If c.ColumnIndex = 1 Or c.ColumnIndex = index Then
            percent = 0.08
            SetCellWidth percent, c
            
            
        
        
        Else
            percent = 0.42
            SetCellWidth percent, c
        
        ' MsgBox c.PreferredWidthType
        ' MsgBox c.PreferredWidth
        End If
         
        
    Next c
    
    
End Function


Function SetCellWidth(percent As Single, c As cell) As Variant


    ' Dim tbl As Table
    Dim total_long As Double
    
    ' Set tbl = Selection.Tables(1) ' 假设选中的是表格中的单元格
    
    ' 获取第2行第4列的单元格
    ' Dim cell As cell
    ' Set cell = tbl.Range.Cells(Now_index)
    
    ' 取消选中"指定宽度"复选框
    c.Select
    Selection.Cells(1).Select
    ' Selection.Cells(1).PreferredWidthType = wdPreferredWidthAuto
    
    
    total_long = CalculateTotalWidth
    
    MsgBox "总长" & total_long
    ' 设置单元格的宽度为5厘米
    Selection.Cells(1).Width = total_long * percent
Exit Function
End Function




Function CalculateTotalWidth() As Double
    Dim totalWidth As Double
    Dim tbl As Table
    
    ' 假设tbl是您要操作的表格对象
    Set tbl = ActiveDocument.Tables(1)
    totalWidth = 0
    
    Dim firstRow As row
    Set firstRow = tbl.Rows(1)
    
    Dim firstCell As cell
    For Each firstCell In firstRow.Cells
        totalWidth = totalWidth + firstCell.Width
    Next firstCell
    
    CalculateTotalWidth = totalWidth
End Function