Avatar of Wilder1626
Wilder1626
Flag for Canada asked on

VB6 - DoEvents problem while extracting to Excel

Hi

I have this below code that generates BarCodes based on values from my MSHFlexgrid1 while the picture is in a PictureBox ("Picture1")

 when run in the IDE, I have each Picture related to the Value from my MSHFlexgrid1.
Ex:
No issue
When i run it with the .exe, this is when i have the problem where the pictures don't match.
Ex:
with issue
The code i have is:
  xlObj.ActiveWorkbook.ActiveSheet.range("A1") = "BARCODE"
    xlObj.ActiveWorkbook.ActiveSheet.range("B1") = "BARCODE VALUE"
    xlObj.ActiveWorkbook.ActiveSheet.Columns("A").ColumnWidth = 37.59


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

        For gridRow = 1 To MSHFlexGrid1.Rows - 1
            If MSHFlexGrid1.TextMatrix(gridRow, 1) <> "" Then
  
                For xlRow = 2 To (MSHFlexGrid1.Rows - 1) + 1
                    If xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 2) = "" Then

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

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

                       ' Sleep 200 ' to sleep for 1 second

                        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 = 200
                        xlObj.ActiveWorkbook.ActiveSheet.Rows(xlRow).RowHeight = 61
                        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


I did try "DoEvents' at multiple places but still having the same problem.

How can i fix this?

Thank you for your help.
Extract-to-Excel-issue-no1.zip
* vb6Microsoft ExcelVisual Basic ClassicMicrosoft Office

Avatar of undefined
Last Comment
Wilder1626

8/22/2022 - Mon
Ryan Chong

you got the same barcode image because you made it static in your code:

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

you need to retrieve the correct image path before you insert that image into the Excel.
Wilder1626

ASKER
That image get's overwritten in a loop :"C:\Pic.bmp", so the picture is never the same. You can see it when you run it in the IDE and not with .exe.
Wilder1626

ASKER
I found it. Now it's working using this: "C:\Pic" & gridRow & ".bmp"

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

        For gridRow = 1 To MSHFlexGrid1.Rows - 1
            If MSHFlexGrid1.TextMatrix(gridRow, 1) <> "" Then
  
                For xlRow = 2 To (MSHFlexGrid1.Rows - 1) + 1
                    If xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 2) = "" Then

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

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

                       ' Sleep 200 ' to sleep for 1 second

                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).AddComment.Shape.Fill.UserPicture "C:\Pic" & gridRow & ".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 = 200
                        xlObj.ActiveWorkbook.ActiveSheet.Rows(xlRow).RowHeight = 61
                        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

I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
Ryan Chong

That image get's overwritten in a loop :"C:\Pic.bmp"
why you want to overwritten it? why don't you saved as a series of images?
Wilder1626

ASKER
i didn't want to create a tone of images. sometime, i can create up to 200.
Wilder1626

ASKER
I still need to look at it. still doesn't work with: "C:\Pic" & gridRow & ".bmp"
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Ryan Chong

if you insist to use Pic.bmp as the only output, you probably can put the DoEvents statement after the SavePicture .

like:

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

Open in new window

Wilder1626

ASKER
even after the save, i still get the same problem.
   '********************************************************************************************************
                        SavePicture Picture1.Image, "C:\Pic.bmp"
 '********************************************************************************************************
Wilder1626

ASKER
I just tried bellow without success:
                        '********************************************************************************************************
                        SavePicture Picture1.Image, "C:\Pic_" & MSHFlexGrid1.Row & ".bmp"
                        '********************************************************************************************************

DoEvents

                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).AddComment.Shape.Fill.UserPicture "C:\Pic_" & MSHFlexGrid1.Row & ".bmp"

Open in new window

All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Ryan Chong

ooops, I missed out an important part!

before:

SavePicture Picture1.Image, "C:\Pic" & gridRow & ".bmp"

you need to reload image to Picture1.

Think you need to add LoadPicture method to reload image before you save the picture...
Jan Karel Pieterse

You are taking the picture from a control called Picture1, but I don't see any code that actually changes the image of Picture1 in the loop which populates Excel?
Wilder1626

ASKER
Jan, what makes the Picture1 change is:
makeBC

Open in new window

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Ryan Chong

can you tell where's the image source that loaded into Picture1 ?

why don't you just use it directly in:

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

Open in new window


instead of load it into a PictureBox, and then Save it to a location and use that file for your process?
Wilder1626

ASKER
The barcode get generated everytime a number is populated in Text1. So it loops every numbers (one by one) from the grid by putting each number in Text1 and save the picture to use it in the Excel file. Then it goes to the next number from the grid...

You can test the barcode manually if you type directly in Text1. You will see the barcode being generated.
barcode generated
To understand how the barcode and Picture1 gets generated based on Text1, see below code:
Private Sub makei25()
Dim x As Long, y As Long, pos As Long
Dim Bardata As String
Dim Cur As String
Dim temp As String
Dim chksum As Long
Dim BC(11) As String
    '2 of the 5 elements are wide: 0=narrow, 1=wide
    BC(0) = "00110" '0
    BC(1) = "10001" '1
    BC(2) = "01001" '2
    BC(3) = "11000" '3
    BC(4) = "00101" '4
    BC(5) = "10100" '5
    BC(6) = "01100" '6
    BC(7) = "00011" '7
    BC(8) = "10010" '8
    BC(9) = "01010" '9
    BC(10) = "0000" 'Start chr
    BC(11) = "100" 'Stop chr
    
    Picture1.Cls
    If Text1.Text = "" Then Exit Sub
    pos = 20
    Bardata = Text1.Text
    
    'make even num of digits by adding a leading 0
    If Len(Bardata) Mod 2 And Not Check1(2).Value Then Bardata = "0" & Bardata
    If Not (Len(Bardata) Mod 2) And Check1(2).Value Then Bardata = "0" & Bardata
    
    'Check for invalid characters and calculate check sum
    For x = 1 To Len(Bardata)
        Cur = Mid$(Bardata, x, 1)
        If Cur < "0" Or Cur > "9" Then
            Picture1.Print Cur & " is Invalid"
            Exit Sub
        End If
        'make checksum
        If x Mod 2 Then
            chksum = chksum + CLng(Cur) * 3
        Else
            chksum = chksum + CLng(Cur)
        End If
    Next
    
    'add check chr to bardata (if selected)
    If Check1(2).Value Then
        chksum = (10 - chksum Mod 10) Mod 10
        Bardata = Bardata & Chr$(48 + chksum)
    End If
    
    'interleave the code into a temp string - what'd you think the name meant?
    For x = 1 To Len(Bardata) Step 2
        For y = 1 To 5
            temp = temp & Mid$(BC(Val(Mid$(Bardata, x, 1))), y, 1)
            temp = temp & Mid$(BC(Val(Mid$(Bardata, x + 1, 1))), y, 1)
        Next
    Next
    
    'add Start & Stop characters
    temp = BC(10) & temp & BC(11)
    
    'Generate Barcode
    For x = 1 To Len(temp)
        If x Mod 2 = 0 Then
                'SPACE
                pos = pos + 1 + (2 * Val(Mid$(temp, x, 1))) + Check1(0).Value
        Else
                'BAR
                For y = 1 To 1 + (2 * Val(Mid$(temp, x, 1)))
                    Picture1.Line (pos, 1)-(pos, 58 - Check1(1) * 8)
                    pos = pos + 1
                Next
        End If
    Next

    'Add Label?
    If Check1(1).Value Then
        Picture1.CurrentX = 20 + Len(Bardata) * (2 + Check1(0).Value * 1.3) 'kinda center
        Picture1.CurrentY = 50
        Picture1.Print Bardata;
    End If
End Sub

Open in new window

Wilder1626

ASKER
i see that for some reasons, when using .exe, it doesn't save to "C:\Pic" & gridRow & ".bmp" while using IDE, it does save to "C:\Pic" & gridRow & ".bmp".

That's kind of strange.
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
Wilder1626

ASKER
I'm now seeing the file in "C:\Pic" & gridRow & ".bmp"

But still not uploading in excel file using the .exe
Martin Liss

Have you tried adding a DoEvents directly after the code that uploads the excel file?
Martin Liss

Have you considered doing the whole process in Excel? If you are concerned about making an Excel workbook into an exe this app can apparently do that.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Wilder1626

ASKER
Martin, I just tried to put the DoEvents directly after the code that uploads the excel file but still having the same issue.

I'm getting at the point that this will never work. Oh well!!!

I will look at the Application see if this can be an option for me. It may be the best solution at the end.
Martin Liss

Please re-upload your project including recent changes.
Wilder1626

ASKER
This is the most updated project sample. You will see that using IDE it works bit not when using exe.

I'm also looking at the app you talked about. Will see if this can be a solution. So far, it looks good.
BareCode-1-no3.zip
Your help has saved me hundreds of hours of internet surfing.
fblack61
Wilder1626

ASKER
I don't remember what i did before i sent you the last sample but it looks like it's working now. I will take a pause and will test it again in about an hour, just to make sure i'm not mistaken here.

I'm getting confused right now.
Martin Liss

Status?
Wilder1626

ASKER
After some extra test this afternoon, I still have the same problem with exe, unfortunately.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Martin Liss

Well I have good news/bad news. Using this code, which I don't think I modified, I get 2 different barcodes via the exe.

Private Sub Command6_Click()
'***************************************************************************************************
'xlObj.ActiveWorkbook.ActiveSheet.Range("A1") = "BARCODE"
'xlObj.ActiveWorkbook.ActiveSheet.Range("A3").AddComment.Shape.Fill.UserPicture "C:\Pic.bmp"
'xlObj.ActiveWorkbook.ActiveSheet.Range("A3").Comment.Text " "
'xlObj.ActiveWorkbook.ActiveSheet.Range("A3").Comment.Height = 660
'xlObj.ActiveWorkbook.ActiveSheet.Range("A3").Comment.Shape.Width = 680
'xlObj.ActiveWorkbook.ActiveSheet.Rows("3:3").RowHeight = 62
'xlObj.ActiveWorkbook.ActiveSheet.Columns("A").ColumnWidth = 129.43
'xlObj.ActiveWorkbook.ActiveSheet.Range("A3").Comment.Visible = True
'xlObj.ActiveWorkbook.ActiveSheet.Range("A3").Comment.Shape.Top = xlObj.ActiveWorkbook.ActiveSheet.Range("A3").Top
'xlObj.ActiveWorkbook.ActiveSheet.Range("A3").Comment.Shape.Left = xlObj.ActiveWorkbook.ActiveSheet.Range("A3").Left
'xlObj.ActiveWorkbook.ActiveSheet.Range("A3").Comment.Shape.Placement = 1

'xlObj.ActiveWorkbook.ActiveSheet.Range("B1") = "BARCODE VALUE"
'xlObj.ActiveWorkbook.ActiveSheet.Range("B3") = MSHFlexGrid1.TextMatrix(r, 1)

'***************************************************************************************************



    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 = "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
    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")


    '***************************************************************     MSHFlexGrid1 copy to excel

    Set wksOut = xlObj.ActiveWorkbook.Worksheets.Add
    wksOut.Name = "Extract_data"
    xlObj.ActiveWorkbook.ActiveSheet.range("A1") = "BARCODE"
    xlObj.ActiveWorkbook.ActiveSheet.range("B1") = "BARCODE VALUE"
    xlObj.ActiveWorkbook.ActiveSheet.Columns("A").ColumnWidth = 43.39


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


        For gridRow = 1 To MSHFlexGrid1.Rows - 1
            If MSHFlexGrid1.TextMatrix(gridRow, 1) <> "" Then
            
              Text1.Text = MSHFlexGrid1.TextMatrix(gridRow, 1)
                        
                        
                LastRow = xlObj.ActiveWorkbook.ActiveSheet.range("B1", xlObj.ActiveWorkbook.ActiveSheet.range("B1").End(xlDown)).Rows.Count
                For xlRow = 2 To (MSHFlexGrid1.Rows - 1) + 1
                     makeBC
                        '********************************************************************************************************
                        SavePicture Picture1.Image, "C:\Pic_" & gridRow & ".jpg"
                        '********************************************************************************************************
 
            
                    If xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 2) = "" Then

 'Sleep 4000 ' to sleep for 1 second

                        xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1).AddComment.Shape.Fill.UserPicture "C:\Pic_" & gridRow & ".jpg"

                        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 = 230.38
                        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) = Form1.MSHFlexGrid1.TextMatrix(gridRow, 1)
                        xlRow = xlRow + 1

                    End If
                Next xlRow
            End If
        Next gridRow

    End With


    With xlObj.ActiveWorkbook.ActiveSheet


        On Error Resume Next
        .range("A1").Select
        .range("A1:z1").Interior.Color = RGB(205, 197, 191)
        .Columns("A:z").NumberFormat = "@"
        .Columns("B:B").ColumnWidth = 23
        .range("$A:$B").AutoFilter
    End With

DoEvents

    xlObj.ActiveWorkbook.SaveAs FileNm

    xlObj.Calculation = -4105     '=xlCalculationAutomatic
    xlObj.ScreenUpdating = True
   ' xlObj.Visible = True
    xlObj.DisplayAlerts = False
    xlObj.Close
    xlObj.Quit
    xlObj.Save = True

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

    Me.MousePointer = vbDefault
    Me.Enabled = True
    
    MsgBox "Extract completed"

End Sub

Open in new window

Martin Liss

Here's what it looked like. Note that I used an xlsx file. I'll try it with and xls file and see if that makes a difference.
2018-10-10_16-29-27.jpg
Martin Liss

No  difference with an xls, but Excel 2010 warned me that the file format didn't agree with the extension.
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
Wilder1626

ASKER
ok, let me try something. I'm under Windows 10 and office 365. I will test with another version on another computer. Just in case.

Thanks for the test that you did. Now i know that it really works.
Martin Liss

I'm Windows XP:) Old dog...
Wilder1626

ASKER
Well well well!!!!!

Windows 10 and Excel 2013 on another laptop and the result with .exe is good.

Result
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Wilder1626

ASKER
I just tried with 4 values in MSHFlexgrid1 and it only does the 2 first numbers but in duplicates instead of 4 different numbers. Can you try it on your side please?

I just update this code below:
Private Sub Form_Resize()
 '   Picture1.Width = Form1.Width - 360
 '   makeBC
    
    MSHFlexGrid1.TextMatrix(1, 1) = "1234567"
    MSHFlexGrid1.TextMatrix(2, 1) = "987654"
     MSHFlexGrid1.TextMatrix(3, 1) = "95623"
    MSHFlexGrid1.TextMatrix(4, 1) = "77845"
    MSHFlexGrid1.TextMatrix(0, 0) = "BARCODE VALUE"
    MSHFlexGrid1.TextMatrix(0, 1) = "BARCODE VALUE"
    MSHFlexGrid1.TextMatrix(0, 2) = "BARCODE VALUE"
    
     'Auto column fit
    Dim cell_wid As Single
    Dim col_wid As Single
    Dim C As Long
    Dim r As Long '

    For C = 0 To MSHFlexGrid1.Cols - 1
        col_wid = 0
        For r = 0 To MSHFlexGrid1.Rows - 1
            cell_wid = TextWidth(MSHFlexGrid1.TextMatrix(r, C))
            If col_wid < cell_wid Then col_wid = cell_wid
        Next r
        MSHFlexGrid1.ColWidth(C) = col_wid + 120
    Next C
 '   cmdCommand2.Value = True
End Sub

Open in new window

Martin Liss

Can you supply the msflexgrid that has the 4 barcodes/
Wilder1626

ASKER
This is the one with 4 numbers but it does only the 2 first numbers in duplicates under windows 10 Excel 2013

diplicateBarcode-3-no4.zip
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
ASKER CERTIFIED SOLUTION
Martin Liss

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Wilder1626

ASKER
Thanks again for all your help. I just tried with over 500 numbers and it's all working now. That topic as been a long ride.

Martin, i like the app for Excel. I will see if i can also do something in Excel directly and use the app. I just tested the trial version. Very good.
Martin Liss

I changed a few things.
You were referring to xlObj.ActiveWorkbook which would cause a problem if the probably rare circumstance where the user opened or selected another workbook while the barcode processing was going on so I changed it to wkbOut.ActiveSheet.

I changed the name of the workbook from what was in Label3.Caption to "Barcodes" which you can of course change. Label3 isn't used so the name of the workbook became "Label3".

I deleted the reference to path_link because it wasn't used or defined. (How did the project compile?)

I changed .ShowSave to .ShowOpen in the CommonDialog2 code so that the button says "Open" rather than "Save" which was confusing.

I suggest you add CommonDialog processing at the end when you close the workbook because as it is now the workbook gets saved no matter if you press Yes, No or Cancel in response to SaveAs.

I also suggest you get rid of all the dead command buttons (Command1 through Command5) and their code.
Private Sub Command6_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
    Dim gridRow As Long


    On Error Resume Next

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


    '***************************************************************     MSHFlexGrid1 copy to excel

    Set wksOut = xlObj.ActiveWorkbook.Worksheets.Add
    wksOut.Name = "Extract_data"
    wkbOut.ActiveSheet.range("A1") = "BARCODE"
    wkbOut.ActiveSheet.range("B1") = "BARCODE VALUE"
    wkbOut.ActiveSheet.Columns("A").ColumnWidth = 43.39


     With MSHFlexGrid1
        For gridRow = 1 To MSHFlexGrid1.Rows - 1
            If MSHFlexGrid1.TextMatrix(gridRow, 1) <> "" Then
            
              Text1.Text = MSHFlexGrid1.TextMatrix(gridRow, 1)
                    makeBC
                    '********************************************************************************************************
                    SavePicture Picture1.Image, "C:\Pic_" & gridRow & ".jpg"
                    '********************************************************************************************************
                   If wkbOut.ActiveSheet.Cells(gridRow + 1, 2) = "" Then
                       wkbOut.ActiveSheet.Cells(gridRow + 1, 1).AddComment.Shape.Fill.UserPicture "C:\Pic_" & gridRow & ".jpg"
                       wkbOut.ActiveSheet.Cells(gridRow + 1, 1).Comment.Text " "
                       wkbOut.ActiveSheet.Cells(gridRow + 1, 1).Comment.Height = 660
                       wkbOut.ActiveSheet.Cells(gridRow + 1, 1).Comment.Shape.Width = 230.38
                       wkbOut.ActiveSheet.Rows(gridRow + 1).RowHeight = 62
                       wkbOut.ActiveSheet.Cells(gridRow + 1, 1).Comment.Visible = True
                       wkbOut.ActiveSheet.Cells(gridRow + 1, 1).Comment.Shape.Top = wkbOut.ActiveSheet.Cells(gridRow + 1, 1).Top
                       wkbOut.ActiveSheet.Cells(gridRow + 1, 1).Comment.Shape.Left = wkbOut.ActiveSheet.Cells(gridRow + 1, 1).Left
                       wkbOut.ActiveSheet.Cells(gridRow + 1, 1).Comment.Shape.Placement = 1

                       wkbOut.ActiveSheet.Cells(gridRow + 1, 2) = Form1.MSHFlexGrid1.TextMatrix(gridRow, 1)
                   End If
            End If
        Next gridRow

    End With


    With wkbOut.ActiveSheet


        On Error Resume Next
        .range("A1").Select
        .range("A1:z1").Interior.Color = RGB(205, 197, 191)
        .Columns("A:z").NumberFormat = "@"
        .Columns("B:B").ColumnWidth = 23
        .range("$A:$B").AutoFilter
    End With

DoEvents

    wkbOut.SaveAs FileNm

    xlObj.Calculation = -4105     '=xlCalculationAutomatic
    xlObj.ScreenUpdating = True
    xlObj.Visible = True
    xlObj.DisplayAlerts = False
  '  xlObj.Close
  '  xlObj.Quit
  '  xlObj.Save = True

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

    Me.MousePointer = vbDefault
    Me.Enabled = True
    
    MsgBox "Extract completed"
End Sub

Open in new window

Wilder1626

ASKER
Thanks a lot for all the above recommendations and code updates. Really appreciated.  I will follow them for sure. Will work on it and i will let you know if i have any questions.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.