vba - 在其他单元格之后复制图片范围名称

Question

我正在尝试复制 B 列中的图片单元格，并将它们命名为第 1 列中的值。我有有效的代码，除了它不断给图片提供错误的名称。令人费解的是，有时它可以完美运行，而其他时候则不能。

我试图根据发布的 CopyPicture 命令示例拼凑一个例程。我把它贴在下面。

是的，我是 VBScript 的新手。要温柔。;-)

Sub makepic()
    Dim path As String
    path = "C:\BP\BP2020\JPGs\"
    Dim CLen As Integer
    Dim cntr As Integer
    cntr = 1
    Dim rgExp As Range
    Dim CCntr As String
    CString2 = "A1:A6"
    Set rgExp2 = Range(CString2)
    CString = "B1:B6"
    Set rgExp = Range(CString)

    For I = 1 To rgExp.Cells.Count Step 1
      CCntr = rgExp2.Cells(I).Value
      rgExp.Cells.Cells(I).Font.Size = 72
      rgExp.Cells.Cells(I).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
      rgExp.Cells.Cells(I).Font.Size = 14
      ''' Create an empty chart with exact size of range copied
      CLen = Len(rgExp.Cells.Cells(I).Value)
      CWidth = CLen * 85

      With ActiveSheet.ChartObjects.Add(Left:=1600, Top:=rgExp.Top, _
        Width:=CWidth, Height:=50)
        .Name = "ChartVolumeMetricsDevEXPORT"
        .Activate
      End With

      ''' Paste into chart area, export to file, delete chart.
      If CCntr <> "" Then
        ActiveChart.Paste

        Selection.Name = "pastedPic"

        ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export (path + CCntr & ".jpg")
        ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete
      End If
      cntr = cntr + 1
   Next
End Sub

同样，我希望 - 例如 - 单元格 B1 内容的图片具有 A1 内容的名称。我尝试制作 A1:B4 范围（例如），但这给了我 8 张照片。我最终决定尝试制作 2 个范围，但这也不起作用。

标签： vba