大家好，我想在WPS中用VBA将word文档中所有表格转化为图片，但是下面的代码没有达到对应的效果，请大家指点一二
Sub 将所有表格粘贴为图片()
Dim tbl As Table
Dim i As Long
'循环遍历所有表格
For Each tbl In ActiveDocument.Tables
' 复制表格为图像，并将图像格式指定为 JPEG
tbl.Range.CopyAsPicture Appearance:=wdTableFormatOriginalSize, Format:=wdChartPicture, _
Size:=wdUndefined, DPI:=72, Verb:=wdExportDocumentContent
Selection.HomeKey Unit:=wdLine, Extend:=wdMove
Selection.MoveUp Unit:=wdLine, count:=1, Extend:=wdMove
Selection.EndKey Unit:=wdLine, Extend:=wdMove
Selection.TypeParagraph
Selection.Paste
Selection.Range.PasteAndFormat (wdChartPicture)
Next tbl
End Sub
弄好了，但是下面的这一段代码虽然可以把所有的表格转化为图片，但是会导致表格的左边框线消失，并且图片右侧也有一部分空白的地方，如何改进
Sub 将所有表格粘贴为图片()
Dim tbl As Table
Dim i As Long
'循环遍历所有表格
For Each tbl In ActiveDocument.Tables
' 复制表格为图像，并将图像格式指定为 JPEG
tbl.Range.Select
With Selection
.CopyAsPicture
.HomeKey Unit:=wdLine, Extend:=wdMove
.MoveUp Unit:=wdLine, count:=1, Extend:=wdMove
.EndKey Unit:=wdLine, Extend:=wdMove
.TypeParagraph
.PasteSpecial DataType:=wdPasteMetafilePicture
End With
Next tbl
End Sub
Sub 打卡记录转考勤表wps()
Dim arr, name_dict, date_dict, date_count, ws, i, j, k
tm = Now()
arr = [a1].CurrentRegion.Value
Set name_dict = CreateObject("scripting.dictionary")
Set date_count = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
name_1 = arr(i, 1)
date_1 = Format(arr(i, 2), "yyyy/m/d")
date_count(date_1) = "" '统计所有出现过的日期
If Not name_dict.Exists(name_1) Then '姓名字典键不存在，新增
Set date_dict = CreateObject("scripting.dictionary") '日期字典
Set name_dict(name_1) = date_dict
name_dict(name_1)(date_1) = arr(i, 2)
Else '姓名字典键存在
If Not name_dict(name_1).Exists(date_1) Then '但日期键不存在
name_dict(name_1)(date_1) = arr(i, 2)
Else '日期键存在，添加值
name_dict(name_1)(date_1) = name_dict(name_1)(date_1) & "," & arr(i, 2)
End If
End If
Next
Set ws = Worksheets.Add(after:=Sheets(Sheets.count)) '最后添加新sheet
ws.Name = "考勤表"
nk = name_dict.keys
nv = name_dict.Items
For i = 0 To name_dict.count - 1 '遍历姓名字典
dk = name_dict(nk(i)).keys
dv = name_dict(nk(i)).Items
For j = 0 To name_dict(nk(i)).count - 1 '遍历日期字典
trr = Split(dv(j), ",") '分割函数，返回从0计数的一维数组
ReDim t(UBound(trr))
For k = 0 To UBound(trr) 'string数组转date数组
t(k) = CDate(trr(k))
Next
work_time = Round((WorksheetFunction.Max(t) - WorksheetFunction.Min(t)) * 24, 2)
'写入表格
ws.Cells(1, 1).Resize(1, 3) = Array("姓名", "日期", "出勤小时")
write_row = ws.UsedRange.Rows.count + 1 '第一个空行写入
ws.Cells(write_row, 1).Resize(1, 3) = Array(nk(i), dk(j), work_time)
'Exit For
Next
Next
'统计表
Cells(2, 6).Resize(name_dict.count, 1) = WorksheetFunction.Transpose(name_dict.keys) '姓名
Cells(1, 7).Resize(1, date_count.count) = date_count.keys '所有出现过的日期
For i = 7 To (7 + date_count.count - 1)
col_add = Split(Columns(i).Address(0, 0), ":")
Cells(2, i).Formula = "=SUMIFS($C:$C,$A:$A,$F2,$B:$B,$" & col_add(0) & "$1)"
Cells(2, i).AutoFill Destination:=Range(Cells(2, i), Cells(2 + name_dict.count - 1, i))
Next
Cells(2, 7).CurrentRegion.Value = Cells(2, 7).CurrentRegion.Value '清除公式
Debug.Print ("打卡记录转考勤表完成，累计用时" & Format(Now() - tm, "hh:mm:ss")) '耗时
End Sub