VB6 - Extract MSHFlexgrid pictures into Excel

Hi

I would like to extract each barcode picture from my MSHFlexgrid1 into excel so that people can scan them.

Right now, it only extract the number and not the barcode itself.

How can i do the barcode extract?

Bacode in mshflexgrid1
This is the extract code i have.

  Dim xlObj As Object    'New Excel.Application -- only used with Excel reference
    Dim wkbOut As Object   'Excel.Workbook
    Dim wksOut As Object   'Excel.Worksheet
    Dim rngOut As Object   'Excel.Range
    Dim sngStart As Single    'forperformance measurement
    Dim start_time As Long
    Dim end_time As Long
    Dim total_time As Long
    Dim FileNm As Variant

    On Error Resume Next

    'Save file to
    With CommonDialog2
        .DialogTitle = "BarCode extract..."
        .FileName = Label3.Caption
        .CancelError = True  '<--moved
        '.Filter = "Excel Files (*.xls)|*.xls"
        ' .Filter = "Spreadsheet Files (*.xls)|*.xls| 2k7 Excel Files (*.xlsx)|*.xlsx"
        .Filter = "Spreadsheet Files (*.xls)|*.xls| 2k7 Excel Files (*.xlsx)|*.xlsx"
        .ShowSave


        If Err.Number = 32755 Then
            MsgBox "not saved - user pressed cancel or closed the dialog"
            Exit Sub
        Else
            FileNm = .FileName
            path_link = FileNm & ".xls"
        End If

    End With
    'output to Excel workbook
    '  lblStatus.Caption = "Begin Excel Data Export"
    Set xlObj = CreateObject("Excel.Application")
    Set wkbOut = xlObj.Workbooks.Add
    Set wksOut = wkbOut.Worksheets("Sheet1")  'can skip this step
    Set rngOut = wksOut.Range("A1")           'by replacing with wkbOut.Worksheets("Sheet1").Range("A1")

    Me.MousePointer = vbHourglass
    Me.Enabled = False

    xlObj.ScreenUpdating = False
    xlObj.Calculation = -4135     '=xlCalculationManual

    ' sngStart = Timer1
    start_time = Format(Now, "ss")


    '  Timer1.Enabled = True
    'BulkLoad rngOut, sngData


    Set wksOut = xlObj.ActiveWorkbook.Worksheets.Add
    wksOut.Name = "Extract_data"


    Clipboard.Clear    'Clear the Clipboard
    With MSHFlexGrid1
        .Col = 0
        .Row = 0
        .ColSel = .Cols - 1
        .RowSel = .Rows - 1
        Clipboard.SetText .Clip
    End With
    With xlObj.ActiveWorkbook.ActiveSheet
        .Range("A1").Select
        .Range("A1:z1").Interior.Color = RGB(205, 197, 191)
        .Columns("A:z").NumberFormat = "@"
        .Paste
        .Columns("A:z").AutoFit

        .Columns("A").Delete

    End With

    xlObj.ActiveWorkbook.SaveAs FileNm

    xlObj.Calculation = -4105     '=xlCalculationAutomatic
    xlObj.ScreenUpdating = True
    xlObj.Visible = True

    Set rngOut = Nothing
    Set wksOut = Nothing
    Set wkbOut = Nothing
    Set xlObj = Nothing

    Me.MousePointer = vbDefault
    Me.Enabled = True

Open in new window

LVL 11
Wilder1626Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Wilder1626Author Commented:
At row 64, i tried bellow but this is only doing a picture in the excel file instead of adding the barcode pictures separately.
Clipboard.SetData .Picture

Open in new window

0
Martin LissOlder than dirtCommented:
Can you supply a sample project?
0
Wilder1626Author Commented:
Hi Martin,

here is a sample.
BareCode-1.zip
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Martin LissOlder than dirtCommented:
Do either of these work?

Clipboard.SetData ,CellPicture, vbCFBitmap

Clipboard.SelPicture .Clip
0
Wilder1626Author Commented:
When i try both options i always get a "Method or Data member not found" error
0
Martin LissOlder than dirtCommented:
I'm not making a lot of progress but when you say .Paste, does the data go to A1? If so you shouldn't be following it with .Columns("A").Delete
0
Martin LissOlder than dirtCommented:
I'm sorry but I give up.
0
Wilder1626Author Commented:
Sorry for yesterday's interruption. Here is an excel file with current extract and also what i would like to see.

Current extra:
Current extract
Should be:
Should be
At the end, i would like to be able to filter, sort the information instead of having a huge picture with all the data in it.
Label3_sample.xls
0
Martin LissOlder than dirtCommented:
Did you produce the workbook and/or transfer the picture to it via code? If so please show me the code.
0
Wilder1626Author Commented:
I actually transferred the picture manually just as a mockup. No code attached to that result in the "Should be" sheet.
0
Wilder1626Author Commented:
just to give a little more information, the barcode in the MSHFlexgrid1 come from a Picture1 just under the MSHFlexgrid1. It's just hidden.
The code to transfer the barcode is:
  Dim k As Long
    For k = 1 To MSHFlexGrid1.Rows - 1

If MSHFlexGrid1.TextMatrix(k, 1) > "" Then

Text1 = MSHFlexGrid1.TextMatrix(k, 1)
MSHFlexGrid1.TextMatrix(k, 2) = Text1
MSHFlexGrid1.TextMatrix(0, 2) = "Values"

With MSHFlexGrid1
    .Row = k
    .Col = 1
    .RowSel = k
    .ColSel = 1
    .CellAlignment = flexAlignCenterCenter
    Set .CellPicture = Picture1.Image
    .RowHeight(k) = 1000

  End With
End If
Next k

Open in new window

0
Martin LissOlder than dirtCommented:
the barcode in the MSHFlexgrid1 come from a Picture1 just under the MSHFlexgrid1.
How does that picture get there? Is there just one picture that contains an image of both barcodes? If so I don't believe it's possible to do what you want.
0
Wilder1626Author Commented:
In the MSHFlexgrid1  column 1, i have Numbers.
Example for the samle project:
When i run the project, it adds numbers but in real life i will add a list of numbers provided by different person.

MSHFlexGrid1.TextMatrix(1, 1) = "1234567"
    MSHFlexGrid1.TextMatrix(2, 1) = "987654"

Open in new window


Then, I loop each numbers in that column to transfer the number in column 2 and i replace the column 1 number by the barcode as a picture.

barcode updated picture
The loop will put the number from column 1 in that "Barcode Data" Text1 and create the barcode picture, and then, it puts the barcode picture into the cell of the MSHFlexgrid1 row.

If MSHFlexGrid1.TextMatrix(k, 1) > "" Then

Text1 = MSHFlexGrid1.TextMatrix(k, 1)
MSHFlexGrid1.TextMatrix(k, 2) = Text1
MSHFlexGrid1.TextMatrix(0, 2) = "Values"

With MSHFlexGrid1
    .Row = k
    .Col = 1
    .RowSel = k
    .ColSel = 1
    .CellAlignment = flexAlignCenterCenter
    Set .CellPicture = Picture1.Image
    .RowHeight(k) = 1000

  End With
End If
Next k

Open in new window


Here is the updated project where you will see the what's in above picture.
BareCode-1-no2.zip
0
Martin LissOlder than dirtCommented:
Again I'm sorry to say I can't make it work. I added some code that tries to add the pictures one at a time to the workbook, but no joy. Here's my code. I modified rows 70 to 73 even though I don't know why there there since as far as the workbook goes you aren't copying the mshflexgrid cell but rather what's in the picture. Significantly I also changed line 76.

If you figure it out I'd be very interested in seeing the final result.

Private Sub cmdExcelExtract_Click()
 
    
    Dim xlObj As Object    'New Excel.Application -- only used with Excel reference
    Dim wkbOut As Object   'Excel.Workbook
    Dim wksOut As Object   'Excel.Worksheet
    Dim rngOut As Object   'Excel.Range
    Dim sngStart As Single    'forperformance measurement
    Dim start_time As Long
    Dim end_time As Long
    Dim total_time As Long
    Dim FileNm As Variant

    On Error Resume Next

    'Save file to
    With CommonDialog2
        .DialogTitle = "BarCode extract..."
        .FileName = Label3.Caption
        .CancelError = True  '<--moved
        '.Filter = "Excel Files (*.xls)|*.xls"
        ' .Filter = "Spreadsheet Files (*.xls)|*.xls| 2k7 Excel Files (*.xlsx)|*.xlsx"
        .Filter = "Spreadsheet Files (*.xls)|*.xls| 2k7 Excel Files (*.xlsx)|*.xlsx"
        .ShowSave


        If Err.Number = 32755 Then
            MsgBox "not saved - user pressed cancel or closed the dialog"
            Exit Sub
        Else
            FileNm = .FileName
            path_link = FileNm & ".xls"
        End If

    End With
    'output to Excel workbook
    '  lblStatus.Caption = "Begin Excel Data Export"
    Set xlObj = CreateObject("Excel.Application")
    Set wkbOut = xlObj.Workbooks.Add
    Set wksOut = wkbOut.Worksheets("Sheet1")  'can skip this step
    Set rngOut = wksOut.Range("A1")           'by replacing with wkbOut.Worksheets("Sheet1").Range("A1")

    Me.MousePointer = vbHourglass
    Me.Enabled = False

    xlObj.ScreenUpdating = False
    xlObj.Calculation = -4135     '=xlCalculationManual

    ' sngStart = Timer1
    start_time = Format(Now, "ss")


    '  Timer1.Enabled = True
    'BulkLoad rngOut, sngData




    '***************************************************************     MSHFlexGrid_rate copy to excel

    Set wksOut = xlObj.ActiveWorkbook.Worksheets.Add
    wksOut.Name = "Extract_data"


    Clipboard.Clear    'Clear the Clipboard
    
    Dim intRow As Integer
    With MSHFlexGrid1
        For intRow = 0 To .Rows - 1
            .Col = 1 '0
            .Row = intRow
            .ColSel = .Cols - 2 '1
            .RowSel = intRow '.Rows - 1
'            Clipboard.SetData .Picture
          'Clipboard.Picture .Clip
          Clipboard.SetData Picture1.Picture

            With xlObj.ActiveWorkbook.ActiveSheet
                .Range("A1").Select
                .Range("A1:z1").Interior.Color = RGB(205, 197, 191)
                .Columns("A:z").NumberFormat = "@"
                Stop
                .cells(intRow + 1, "A").Paste '.Paste

                .Columns("A:z").AutoFit
        
               'Columns("A").Delete
            End With
        Next

    End With

    xlObj.ActiveWorkbook.SaveAs FileNm

    xlObj.Calculation = -4105     '=xlCalculationAutomatic
    xlObj.ScreenUpdating = True
    xlObj.Visible = True

    Set rngOut = Nothing
    Set wksOut = Nothing
    Set wkbOut = Nothing
    Set xlObj = Nothing

    Me.MousePointer = vbDefault
    Me.Enabled = True


End Sub

Open in new window

0
Wilder1626Author Commented:
Thanks for your help. I will keep the topic open for now but if i found something, i will definitely let you know.
0
Wilder1626Author Commented:
Martin,

How can i insert a picture in a specific cell if the picture was saved on my "C:\"?

I've tried like below but it all goes to A1 by default.

  '***************************************************************************************************
      With xlObj.ActiveWorkbook.ActiveSheet.Pictures.Insert("C:\Pic.bmp")
                    .Left = .Range("D10").Left
                    .Top = .Range("D10").Top
                    .Placement = xlMoveAndSize
       End With
'********************************************************************************************************

Open in new window

0
Wilder1626Author Commented:
After multiple attempt, I was able to find a way to do something. Now i just need to put a loop into it.

Code so far:
  '***************************************************************************************************
xlObj.ActiveWorkbook.ActiveSheet.Range("A1") = "BARCODE"
xlObj.ActiveWorkbook.ActiveSheet.Range("A2").AddComment.Shape.Fill.UserPicture "C:\Pic.jpg"
xlObj.ActiveWorkbook.ActiveSheet.Range("A2").Comment.Text " "
xlObj.ActiveWorkbook.ActiveSheet.Range("A2").Comment.Height = 660
xlObj.ActiveWorkbook.ActiveSheet.Range("A2").Comment.Shape.Width = 680
xlObj.ActiveWorkbook.ActiveSheet.Rows("2:2").RowHeight = 62
xlObj.ActiveWorkbook.ActiveSheet.Columns("A").ColumnWidth = 129.43
xlObj.ActiveWorkbook.ActiveSheet.Range("A2").Comment.Visible = True
xlObj.ActiveWorkbook.ActiveSheet.Range("A2").Comment.Shape.Top = xlObj.ActiveWorkbook.ActiveSheet.Range("A2").Top
xlObj.ActiveWorkbook.ActiveSheet.Range("A2").Comment.Shape.Left = xlObj.ActiveWorkbook.ActiveSheet.Range("A2").Left
xlObj.ActiveWorkbook.ActiveSheet.Range("A2").Comment.Shape.Placement = 1

xlObj.ActiveWorkbook.ActiveSheet.Range("B1") = "BARCODE VALUE"
xlObj.ActiveWorkbook.ActiveSheet.Range("B2") = Text1.Text
'********************************************************************************************************

Open in new window


The result does this:
Sample resultSample-no2.xlsx
0
Martin LissOlder than dirtCommented:
This is code form before I gave up for the 2nd time. It didn't work but it has a loop. I used  intRow + 10 because when I used A1 or A2 the picture kept getting placed in the formula bar! ntRow + 10 didn't change that/

   
 Clipboard.Clear    'Clear the Clipboard
    Dim intRow As Integer
    With MSHFlexGrid1
        For intRow = 0 To .Rows - 1
'            .Col = 0
'            .Row = intRow
'            .ColSel = .Cols - 1
'            .RowSel = .Rows - 1
'            Clipboard.SetData .Picture
          'Clipboard.Picture .Clip
          Clipboard.SetData Picture1.Picture, vbCFBitmap
'          Clipboard.SetData Me.Picture1.Picture
xlObj.ActiveWorkbook.Sheets(wksOut.Name).Activate

           With xlObj.ActiveWorkbook.ActiveSheet
                .Range("A1").Select
                '.Range("A1:z1").Interior.Color = RGB(205, 197, 191)
                '.Columns("A:z").NumberFormat = "@"
                Set rngOut = .Cells(intRow + 10, "A")
'                .cells(intRow + 10, "A").Paste '.Paste
                rngOut.Paste '.Paste
                .Columns("A:z").AutoFit
        
               'Columns("A").Delete
            End With
        Next

    End With

Open in new window

0
Wilder1626Author Commented:
I will use your second code with the loop, and once completed, and will send you the final project sample result.
0
Martin LissOlder than dirtCommented:
The only take-away for you from my code should be lines 6, 20 and 26.
0
Wilder1626Author Commented:
ok. thanks. i'm working on it now. Hopefully it will be quick.
0
Martin LissOlder than dirtCommented:
I should have said 4, 20 and 26.
0
Wilder1626Author Commented:
right now, i'm trying to see how i will transfer the MSHFlexgrid row by row to the excel file while overwriting the Pic.bmp every time i change row.
0
Martin LissOlder than dirtCommented:
Make sure you do Appication,ScreenUpdating = False, otherwise it probably will be slow.
0
Wilder1626Author Commented:
So far, i did below on the loop but for some reason, i only have row 2 populated with first picture in column 1 and second number in column 2 when i should have row 2 and 3 populated.


xlObj.ActiveWorkbook.ActiveSheet.Range("A1") = "BARCODE"
xlObj.ActiveWorkbook.ActiveSheet.Range("B1") = "BARCODE VALUE"
xlObj.ActiveWorkbook.ActiveSheet.Columns("A").ColumnWidth = 129.43


With MSHFlexGrid1
    Dim r As Long
    Dim Rows, Cols As Integer
    Dim i As Long
    
    Rows = .Rows
    
    For r = 1 To MSHFlexGrid1.Rows - 1
        For i = 0 To Rows - 1
            
            If MSHFlexGrid1.TextMatrix(r, 1) <> "" Then
                Text1.Text = MSHFlexGrid1.TextMatrix(r, 1)
                makeBC
                
                '********************************************************************************************************
                SavePicture Picture1.Image, "C:\Pic.bmp"
                '***************************************************************************************************
                
                If xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Value = "" Then
                    
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).AddComment.Shape.Fill.UserPicture "C:\Pic.bmp"
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Comment.Text " "
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Comment.Height = 660
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Comment.Shape.Width = 680
                    xlObj.ActiveWorkbook.ActiveSheet.Rows(i).RowHeight = 62
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Comment.Visible = True
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Comment.Shape.Top = xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Top
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Comment.Shape.Left = xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Left
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 1).Comment.Shape.Placement = 1
                    
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(i, 2) = Text1.Text
                    
                End If
                
            End If
        Next i
    Next r
            
End With

Open in new window

0
Martin LissOlder than dirtCommented:
The structure of Cells() is Cells(row, column)  and your 'i' therefore refers to a row. Try Cells(1, i) instead.


'i' is hard to distinguish from '1' and since it's  always good to use descriptive variable names, instead of 'i' use something like lngRow.
0
Wilder1626Author Commented:
I understand. I did the update.

I'm using row for the MSHFlexgrid   If MSHFlexGrid1.TextMatrix(gridRow, 1) <> "" . If i have a value, then it looks if  If xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Value = "" . If the cell is empty then it past both, the picture in column 1 and the barcode value in column 2.

But i still have the same problem. It only paste in the row 2.

xlObj.ActiveWorkbook.ActiveSheet.Range("A1") = "BARCODE"
xlObj.ActiveWorkbook.ActiveSheet.Range("B1") = "BARCODE VALUE"
xlObj.ActiveWorkbook.ActiveSheet.Columns("A").ColumnWidth = 129.43


With MSHFlexGrid1
    Dim gridRow As Long, xlRow As Long
    Dim Rows, Cols As Integer
    
    Rows = .Rows
    
    For gridRow = 1 To MSHFlexGrid1.Rows - 1
        For xlRow = 1 To Rows - 1
            
            If MSHFlexGrid1.TextMatrix(gridRow, 1) <> "" Then
                Text1.Text = MSHFlexGrid1.TextMatrix(gridRow, 1)
                makeBC
                
                '********************************************************************************************************
                SavePicture Picture1.Image, "C:\Pic.bmp"
                '***************************************************************************************************
                
                If xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Value = "" Then
                    
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).AddComment.Shape.Fill.UserPicture "C:\Pic.bmp"
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Text " "
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Height = 660
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Shape.Width = 680
                    xlObj.ActiveWorkbook.ActiveSheet.Rows(xlRow).RowHeight = 62
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Visible = True
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Shape.Top = xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Top
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Shape.Left = xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Left
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Shape.Placement = 1
                    
                    xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 2) = Text1.Text
                    
                End If
                
            End If
        Next xlRow
    Next gridRow
            
End With

Open in new window

0
Martin LissOlder than dirtCommented:
Rows = .Rows
    
    For gridRow = 1 To MSHFlexGrid1.Rows - 1
        For xlRow = 1 To Rows - 1

Open in new window


If you have two rows in the grid, line 1 will make Rows = 2. Line 4 therefor will be interpreted as For xlRow = 1 To 2 - 1  which is the same as For xlRow = 1 To 1, so you only get one row.
0
Wilder1626Author Commented:
i've got some issues with the loop to push the images in empty cells still.

I will do some extra test and will send an updated project update if i'm still having the problem.
0
Wilder1626Author Commented:
I found a way to do it accept that it leaves an empty row between them. But it's not that bad.

Extract result
    xlObj.ActiveWorkbook.ActiveSheet.range("A1") = "BARCODE"
    xlObj.ActiveWorkbook.ActiveSheet.range("B1") = "BARCODE VALUE"
    xlObj.ActiveWorkbook.ActiveSheet.Columns("A").ColumnWidth = 129.43


    With MSHFlexGrid1
        Dim gridRow As Long, xlRow As Long
        Dim LastRow As Long


        For gridRow = 0 To MSHFlexGrid1.Rows - 1
            If MSHFlexGrid1.TextMatrix(gridRow, 1) <> "" Then

                LastRow = xlObj.ActiveWorkbook.ActiveSheet.range("B2", xlObj.ActiveWorkbook.ActiveSheet.range("B2").End(xlDown)).Rows.Count
                For xlRow = 0 To xlObj.ActiveWorkbook.ActiveSheet.LastRow
                
                    If xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 2) = "" Then

                        Text1.Text = MSHFlexGrid1.TextMatrix(gridRow, 1)
                        makeBC

                        '********************************************************************************************************
                        SavePicture Picture1.Image, "C:\Pic.bmp"
                        '********************************************************************************************************

                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).AddComment.Shape.Fill.UserPicture "C:\Pic.bmp"
                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Text " "
                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Height = 660
                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Shape.Width = 680
                        xlObj.ActiveWorkbook.ActiveSheet.Rows(xlRow).RowHeight = 62
                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Visible = True
                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Shape.Top = xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Top
                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Shape.Left = xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Left
                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Shape.Placement = 1

                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 2) = Text1.Text
                        xlRow = xlRow + 1

                    End If
                Next xlRow
            End If
        Next gridRow

    End With

Open in new window

0
Martin LissOlder than dirtCommented:
How did you come up with 62 for the column width? Try increasing it temporarily to 100 and also increasing the width of column 'A'.
0
Wilder1626Author Commented:
I came up to 62 as it is the same width as the picture in it.
0
Wilder1626Author Commented:
Here is a sample of the project that you can test...

If you click on the command button "New code Extract to  Excel", this will extract the MSHFlexgrid1 Barcodes values plus the images of the barcodes.

resultBareCode-1-no3.zip
0
Martin LissOlder than dirtCommented:
I came up to 62 as it is the same width as the picture in it.
When I was looking around the web for possible help with your project I saw a video where the programmer was copy/pasting images from one cell to another. In that video he would manually select the cell to which the picture would be pasted and he showed that it wouldn't work unless the area selected was bigger than the picture. That's why I suggested enlarging it.
0
Wilder1626Author Commented:
got it. Thanks for the info.

Now i see a problem. If i run the extract from VB6, it extract without any problems. But when i make an .exe and use it to extract the to excel, it doesn't work. Very strange!!!
0
Martin LissOlder than dirtCommented:
I fixed the skipping rows problem, There is no 'LastRow' property in Excel and there's no '0' row, so in Command6_Click(), change
For xlRow = 0 To xlObj.ActiveWorkbook.ActiveSheet.LastRow

to

For xlRow = 2 To (MSHFlexGrid1.Rows - 1) + 1

That may also fix the exe problem.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Wilder1626Author Commented:
I just tested :
For xlRow = 2 To (MSHFlexGrid1.Rows - 1) + 1

Open in new window


Once I create the .exe, i have a problem with a picture. I have twice the same picture. Kind of strange.
Issue no 1
0
Martin LissOlder than dirtCommented:
exe's run much master then when in the IDE and so long running external process  (like writing to Excel) may not get a chance to complete before the exe moves on to the next line of code which can cause problems. The standard fix for that is to put DoEvents lines after a line of code that may be long running. In other words something like this.

                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).AddComment.Shape.Fill.UserPicture "C:\Pic.bmp"
                        DoEvents
                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).Comment.Text " "

Open in new window


You could experiment with putting DoEvents lines in different places. If you can't fix it then how about closing this question and asking a new one?
0
Wilder1626Author Commented:
Thanks will try it and if it still doesn't work, i will open a new topic.
0
Wilder1626Author Commented:
Thanks for your help.

I will Open a new question for the DoEvents. Still have the same problem once .exe created.
0
Martin LissOlder than dirtCommented:
You’re welcome and I’m glad I was able to help.

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
              Experts Exchange Top Expert VBA (current)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming

From novice to tech pro — start learning today.