WPS 表格合并单元格后的结果不对？

ning84

珠海图书馆06号机器













应该得到的结果

ning84

1. Function K9BaseDateArr()
   
2.    Dim Arr(29)
   
3.        Arr(0) = Array("车站", "路段", "时间", "行驶时间", "行驶距离")
   
4.        Arr(1) = Array("三灶车场", "琴石路", 0.572916666666667, "发车", "<1千米")
   
5.        Arr(2) = Array("映月新村", "映月路", 0.574305555555556, "2分钟", "<1千米")
   
6.        Arr(3) = Array("唐人街", "伟民路", 0.575694444444444, "4分钟", "<1千米")
   
7.        Arr(4) = Array("月堂", "金海岸大道西", 0.577083333333333, "6分钟", "1.2千米")
   
8.        Arr(5) = Array("中南修理厂", "金海岸大道西", 0.577777777777778, "7分钟", "1.6千米")
   
9.        Arr(6) = Array("鱼弄", "金海岸大道东", 0.579861111111111, "10分钟", "2.7千米")
   
10.        Arr(7) = Array("城建总公司", "金海岸大道东", 0.580555555555556, "11分钟", "3.6千米")
    
11.        Arr(8) = Array("斜尾", "金岛路", 0.581944444444444, "13分钟", "3.9千米")
    
12.        Arr(9) = Array("金沙湾豪庭", "金岛路", 0.582638888888889, "14分钟", "4.7千米")
    
13.        Arr(10) = Array("金海岸中学", "金岛路", 0.583333333333333, "15分钟", "5.2千米")
    
14.        Arr(11) = Array("金都大厦", "金岛路", 0.584027777777778, "16分钟", "5.6千米")
    
15.        Arr(12) = Array("金岛路东", "金岛路", 0.585416666666667, "18分钟", "6.0千米")
    
16.        Arr(13) = Array("东咀", "金岛路", 0.586111111111111, "19分钟", "6.4千米")
    
17.        Arr(14) = Array("青湾", "金湾路(S272)", 0.588194444444444, "22分钟", "7.8千米")
    
18.        Arr(15) = Array("金湾高尔夫", "金湾路(S272)", 0.590277777777778, "25分钟", "9.8千米")
    
19.        Arr(16) = Array("二号闸", "金湾路(S272)", 0.592361111111111, "28分钟", "11千米")
    
20.        Arr(17) = Array("时代山湖海", "金湾路(S272)", 0.59375, "30分钟", "12千米")
    
21.        Arr(18) = Array("保利香槟", "金湾路(S272)", 0.594444444444444, "31分钟", "13千米")
    
22.        Arr(19) = Array("湖心路口", "珠海大道中(S366)", 0.596527777777778, "34分钟", "14千米")
    
23.        Arr(20) = Array("翠湾", "珠海大道西(S366)", 0.607638888888889, "50分钟", "26千米")
    
24.        Arr(21) = Array("华发新城", "珠海大道西(S366)", 0.613888888888889, "59分钟", "33千米")
    
25.        Arr(22) = Array("白石(银石雅园)", "九洲大道西(S366)", 0.617361111111111, "1小时4分钟", "35千米")
    
26.        Arr(23) = Array("兰埔(富华里)", "九洲大道西(S366)", 0.618055555555556, "1小时5分钟", "36千米")
    
27.        Arr(24) = Array("隧道南", "迎宾南路", 0.621527777777778, "1小时10分钟", "37千米")
    
28.        Arr(25) = Array("柠溪", "柠溪路", 0.624305555555556, "1小时14分钟", "39千米")
    
29.        Arr(26) = Array("香宁花园", "柠溪路", 0.627083333333333, "1小时18分钟", "40千米")
    
30.        Arr(27) = Array("南香里", "柠溪路", 0.628472222222222, "1小时20分钟", "41千米")
    
31.        Arr(28) = Array("南坑", "紫荆路", 0.629166666666667, "1小时21分钟", "42千米")
    
32.        Arr(29) = Array("香洲", "紫荆路", 0.630555555555556, "1小时23分钟", "42千米")
    
33. 
    
34.        K9BaseDateArr = Arr
    
35. End Function
    
36. 
    
37. 
    
38. Sub Ll()
    
39.    Dim UnionDict As Scripting.Dictionary
    
40.        Set UnionDict = New Scripting.Dictionary
    
41.      
    
42.      Dim Str, Arr
    
43.          Arr = K9BaseDateArr
    
44.      Dim Pres As Presentation
    
45.          Set Pres = Application.ActivePresentation
    
46.      Dim Sld As Slide, Slds As Slides
    
47.          Set Slds = Pres.Slides
    
48.      Dim Shp As Shape, Shps As Shapes, oTab As Table
    
49.          Set Sld = Slds(1)
    
50.          For ii = Sld.Shapes.Count To 1 Step -1
    
51.               Set Shp = Sld.Shapes(ii)
    
52.               Shp.Delete
    
53.          Next ii
    
54.      Dim oRow, oCol, Ll, Tt, Ww, Hh
    
55.          oRow = (UBound(Arr) + 1)
    
56.          oCol = 6
    
57.          Ll = 10
    
58.          Tt = 5
    
59.          With Pres.PageSetup
    
60.               Ww = .SlideWidth * 2 / 3
    
61.               Hh = .SlideHeight
    
62.          End With
    
63.          Set Shps = Sld.Shapes
    
64.          Set oTab = Shps.AddTable(oRow, oCol, Ll, Tt, Ww, Hh).Table
    
65.          Set Shp = Shps(Shps.Count)
    
66.          SetTable oTab, Arr
    
67.          Shp.Name = "L9Table"
    
68.          For Each Shp In Sld.Shapes
    
69.               Debug.Print Shp.Name, Shp.Type
    
70.          Next Shp
    
71.          
    
72. End Sub
    
73. 
    
74. Function SetTable(oTable As Table, Arr)
    
75.    Dim Dict As Scripting.Dictionary
    
76.        Set Dict = New Scripting.Dictionary
    
77.    Dim Str, oStr
    
78.       With oTable
    
79.            
    
80.            For ii = 0 To UBound(Arr)
    
81.                If ii > 0 Then
    
82.                    .Cell(ii + 1, 1).Shape.TextFrame2.TextRange.Text = ii
    
83.                End If
    
84.                For jj = 0 To 4
    
85.                    If jj = 2 Then
    
86.                         .Cell(ii + 1, jj + 2).Shape.TextFrame2.TextRange.Text = Format(Arr(ii)(jj), "h:mm")
    
87.                    Else
    
88.                         .Cell(ii + 1, jj + 2).Shape.TextFrame2.TextRange.Text = Arr(ii)(jj)
    
89.                    End If
    
90.                    If jj = 1 Then
    
91.                        Dict(Arr(ii)(jj)) = Dict(Arr(ii)(jj)) & "," & ii
    
92.                    End If
    
93.                Next jj
    
94.            Next ii
    
95.            '.Cell(5, 3).Merge .Cell(8, 3)
    
96.       
    
97.       End With
    
98.       
    
99.       
    
100.       With Dict
     
101. 
     
102.            For ii = 0 To .Count - 1
     
103.                  Debug.Print .Keys(ii),
     
104.                  Str = .Items(ii)
     
105.                  Str = Mid(Str, 2, Len(Str))
     
106.                  ss = Split(Str, ",")
     
107.                  If UBound(ss) > 1 Then
     
108.                      
     
109.                      Debug.Print ss(0), ss(UBound(ss))
     
110.                      
     
111.                      oTable.Cell(ss(0) + 1, 3).Merge oTable.Cell(ss(UBound(ss)) + 1, 3)
     
112.                      
     
113.                  End If
     
114.                  
     
115.            Next ii
     
116.       End With
     
117. 
     
118. End Function
     

复制代码

ning84

ning84 发表于 2024-10-18 16:06

AI的解答。


在 WPS VBA 中，您可以使用以下代码来设置 PPTM 文件中表格的边框线。请注意，这段代码可能需要根据您的具体需求进行调整。

Sub SetTableBorder()
    Dim ppt As Presentation
    Dim slide As Slide
    Dim table As Table
    Dim row As Row
    Dim cell As Cell
   
    ' 打开 PPTM 文件
    Set ppt = Presentations.Open("C:\path\to\your\file.pptm")
   
    ' 获取第一张幻灯片
    Set slide = ppt.Slides(1)
   
    ' 获取幻灯片中的第一个表格
    Set table = slide.Shapes(1).Table
   
    ' 遍历表格的所有行和单元格
    For Each row In table.Rows
        For Each cell In row.Cells
            ' 设置单元格边框为黑色实线
            cell.Borders.LineStyle = xlContinuous
            cell.Borders.Color = RGB(0, 0, 0)
            cell.Borders.Weight = xlThin
        Next cell
    Next row
   
    ' 保存并关闭 PPTM 文件
    ppt.Save
    ppt.Close
End Sub

这段代码首先打开一个 PPTM 文件，然后获取第一张幻灯片中的第一个表格，并遍历表格的所有行和单元格，设置它们的边框为黑色实线。最后，保存并关闭 PPTM 文件。

请注意，您需要根据实际情况调整代码，例如幻灯片的编号、表格的编号等。此外，您可能需要根据需求调整边框的样式、颜色和粗细。

ning84

ning84 发表于 2024-10-19 02:22
AI的解答。

Ppt表格与Excel表格不一样，结果 ppt合并单元格肯定与Excel合并单元格不一样，所以这个帖子给你提就有问题。


PowerPoint（PPT）和Excel在合并单元格方面有一些显著的区别，主要体现在合并方式、对齐方式以及应用场景上。以下是具体的区别：

### 合并方式

- **PPT合并单元格**：在PPT中，合并单元格的操作相对简单，主要通过选中需要合并的单元格，然后使用右键菜单中的“合并单元格”命令，或者通过功能区的“布局”→“合并”→“合并单元格”按钮来完成。
- **Excel合并单元格**：Excel提供了三种合并单元格的方式：合并单元格、合并后居中和跨越合并。每种方式都有两种方法，一种是通过功能选项，另一种是通过快捷键。

### 对齐方式

- **PPT合并单元格**：PPT合并单元格后，通常保持左上角单元格的对齐方式。
- **Excel合并单元格**：Excel提供了更多的对齐选项，包括合并后居中和跨越合并，这些选项允许用户根据需要调整合并后单元格的对齐方式。

### 应用场景

- **PPT合并单元格**：主要用于创建具有特定布局和设计的表格，以增强视觉呈现效果，适合在演示文稿中使用。
- **Excel合并单元格**：适用于需要进行复杂的数据处理和分析，如数据透视表、条件格式化等，适合在数据分析和报告中使用。

### 其他功能差异

- **PPT表格编辑功能**：PPT的表格编辑功能相对简单，主要集中在插入、设计和布局上，适合快速创建和修改简单的表格结构。
- **Excel表格编辑功能**：Excel提供了丰富的表格编辑功能，包括数据透视表、条件格式化、图表创建等，适合进行深入的数据分析和可视化处理。

总的来说，PPT和Excel在合并单元格方面各有特点，选择哪种工具取决于具体的使用场景和需求。