指定表格区域导出为图片遇阻，只能导出2个。

weiyingde

指定表格区域导出为图片遇阻，只能导出2个。
代码如下：
Private Sub CommandButton1_Click()
批量班周考核
End Sub
Sub 批量班周考核()
Dim arr()
Set fso = CreateObject("Scripting.FileSystemObject")
wjj$ = ThisWorkbook.Path & "\九(2)班周考核"
If fso.FolderExists(wjj$) Then
        fso.DeleteFolder (wjj$)
End If
MkDir wjj$ & "\"


With ActiveSheet
     cnt = (.Range("IV2").End(xlToLeft).Column + 1) / 14
     For i = 1 To cnt
         wdh = .Range(.Cells(1, (i - 1) * 14 + 1), .Cells(1, (i - 1) * 14 + 13)).Width
         lf = .Range(.Cells(1, 1), .Cells(1, (i - 1) * 14 + 13)).Width + 2.67
         hth = .Range(.Cells(1, 1), .Cells(47, 1)).Height
         tp = 0
         fulnm = ThisWorkbook.Path & "\九(2)班周考核\" & "九(2)班" & IIf(i = 1, "前", "第") & IIf(i = 1, cnt, i) & "周情况" & IIf(i = 1, "汇总", "公布") & ".png"
         .Range(.Cells(1, (i - 1) * 14 + 1), .Cells(47, (i - 1) * 14 + 13)).CopyPicture
         With .ChartObjects.Add(lf, tp, wdh, hth).Chart
              .Paste
              .Export fulnm
              .Parent.Delete
         End With
         Nb = Nb + 1
         ReDim Preserve arr(1 To 2, 1 To Nb)
         arr(1, Nb) = fulnm
         arr(2, Nb) = "九(2)班" & IIf(i = 1, "前", "第") & IIf(i = 1, cnt, i) & "周情况" & IIf(i = 1, "汇总", "公布")
     Next
     arr = Application.WorksheetFunction.Transpose(arr)
End With
End Sub

代码其实很简单，不知问题出在哪里。
也许是老眼昏花，检查多遍竟未查出，着急并汗颜。
期待大咖帮我。
先谢为敬。

wowo000

楼主：俺稀里糊涂改一下，不知道是合意？

weiyingde

wowo000 发表于 2024-3-23 18:23
楼主：俺稀里糊涂改一下，不知道是合意？

先感谢。

weiyingde

wowo000 发表于 2024-3-23 18:23
楼主：俺稀里糊涂改一下，不知道是合意？

不错，是这样。

weiyingde

wowo000 发表于 2024-3-23 18:23
楼主：俺稀里糊涂改一下，不知道是合意？

少了一个 .Parent.Select
为什么第一个和第二个导出没问题，请解释。