0

I need to save pictures based single cells within a column which has Chinese characters in it as separate JPGs for inclusion in a Visual FoxPro report.

I have pored through various Stack Overflow questions, such as: Saving range as picture with Excel 2016 and Export pictures from excel file into jpg using VBA However, I'm relatively new at VBA, and I cannot figure out how to iterate through the table to make individual JPGs for each cell (and name them separately as well). Ideally, I would like to name them with the value of another column, but I can also live with naming then with the record number (i.e. 1.jpg, 2.jpg...). I tried making code from another post work (see below), but I haven't had any luck.

Sub makepic()
''' Set Range you want to export to file
    Dim path As String
    path = "C:\BP\BP2020\JPGs\"
    Dim cntr As Integer
    cntr = 1
    Dim rgExp As Range
    Dim CCntr As String
    CString = "A1:B6"
    Set rgExp = Range(CString)
    For Each cell In rgExp
      ''' Copy range as picture onto Clipboard
      rgExp.Cells.Item(cntr, 1).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
      ''' Create an empty chart with exact size of range copied
      With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
        Width:=rgExp.Cells.Item(cntr, 1).Width, Height:=rgExp.Rows(cntr).Height)
        .Name = "ChartVolumeMetricsDevEXPORT"
        .Activate
      End With
      CCntr = rgExp.Cells.Item(cntr, 2)
      cntr = cntr + 1

      ''' Paste into chart area, export to file, delete chart.
      If CCntr <> "" Then
        ActiveChart.Paste
        ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export (path + CCntr & ".jpg")
        ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete
      End If
   Next cell
End Sub

The main error message I was getting concerned "shapes," however I'm not looking at copy pictures out, but to save text in each cell as pictures.

PS: I try to make my questions as succinct and readable as I can, but I am continually getting told I am not phrasing my questions right. This is evidently due to ignorance of the correct format. I have re-read the articles on posting and hope this one "passes muster." If not, I apologize.

John Kiernan
  • 79
  • 10
  • 3
    Please post your actual code as without that it's very difficult to try and tell you where you've gone wrong - no matter how bad you're worried it is, we will have seen worse, I promise you... – Dave Oct 28 '19 at 17:44
  • I have edited the above to show my code. Hopefully, people can help me. – John Kiernan Oct 29 '19 at 00:10
  • CCntr is out of the loop, never gets incremented so each file overwrites the previous so you end up with only one. Think you meant to use path + CStr(cntr) & ".jpg"? Also, as "cntr = cntr + 1" is at the beginning of the loop the jpgs start at 2 (move to just before "Next cell"). Finally, your code looks right, but it grabs the whole "A1:A6" range each loop...sorry don't have time to troubleshoot now, but maybe the CString declaration needs to be "as Range". not included in code so I dont know. Are you using "Option Explicit"?. Definitely good habit to get into! – Stax Oct 29 '19 at 01:00
  • Thanks for the help Stax! Yes, you are absolutely right about the CCntr thing. The routine now makes six JPGs, but they all include ALL six cells. I'm sure it is because of the line: rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap. What I need to do is make that "CopyPicture" look only at the cell, but I cannot figure out how to reference it. I tried rgExp.Cell, rgExp(cntr), but to no avail. How do I get that "CopyPicture" to do so only for the current cell in the loop? Thanks again for your help (or anyone who helps). – John Kiernan Oct 29 '19 at 01:35
  • Yes! instead of rgExp.CopyPicture, try cell.CopyPicture. – Stax Oct 29 '19 at 01:47
  • I did get this to work as I wanted it (see new code above). The first column are the "pictures" (actually Chinese characters), and the second column are the item numbers, which is what I want to name each picture. I have this working, except for one flaw. After I run it the first time (when it runs fine), on the second pass, it makes blank pictures. Then on the third pass, again pictures, on the fourth blank. Weird, huh? Hope this helps figure things out. – John Kiernan – John Kiernan Oct 29 '19 at 04:18
  • At work now, so can't help much for a while. Don't know how I didnt notice this before, but it's looping once for each cell in BOTH columns in "A1:B6", I.e. 12 times. try "A1:A6" instead. (FYI, in the Chart.Export line, replace CCntr with Range(Cells(cntr, 2), Cells(cntr, 2)).Value to have the files named from the values in the respective cells in the second column). – Stax Oct 29 '19 at 05:20

0 Answers0