Simple Bar code generator

I have written a simple bar code generator that steps and repeats an existing graphic and adds a bar code.

In case there are more "labels" needed than fit on the page size you are working on, it stores info by writing and reading text files and lets you carry on in a session until all the labels are output.

It relies on the fact that the Corel Barcode wizard "remembers" the last configuration used, so you simply "initialise" the wizard once with all the parameters (size etc) and paste in the number when the OLE object is inserted.

You can add a suffix, a prefix, and add leading zeros if required.

To position the barcode, an "invisible" box is included in the graphic, this is selected and the position, size etc is stored and used to position the bar code.

It's a bit rough I know, but it works and has saved us a lot of time as traditional barcode hardware and software will not work on many of the substrates we use.

Following is the main part of the working code.

The problem is, my code turns off the number lock - and I can't figure out how to fix it. ANy help?

Private Sub CmdRun_Click()

Dim StartNum As Long
Dim Counter As Long
Dim LenNum As Long
Dim AddDigit As Long
Dim AddDigitStr As String
Dim NumVal As Long
Dim NumLead As String
Dim NumDigits As Long
Dim NumStrWrite As String
Dim SBarC As Shape
Dim Zeros As String
Dim a As Long
Dim b As Long
Dim BarcX As Double
Dim BarcY As Double
Dim Ctmp As New Color
Dim RGBValue
Dim FileNm As String
Dim NmLen As Long

DocNm = ActiveDocument.FullFileName
With CorelScript
ObjID = .GetObjectID
End With

NumAcc = UserForm1.TxtNumAcc
NumUpp = UserForm1.TxtNumUp
GapAcc = UserForm1.txtGapAcc
GapUp = UserForm1.TxtGapUp
Ld0s = UserForm1.TxtLd0s
EndNum = UserForm1.TxtEnNm
ICt = UserForm1.ChkICt
HgtFact = UserForm1.TxtHgtFactor

Open "C:\1Storage\DoNotDelete\AutoCode\File.txt" For Output As #1
Write #1, DocNm
Write #1, ObjID
Write #1, NumAcc
Write #1, NumUpp
Write #1, GapAcc
Write #1, GapUp
Write #1, Ld0s
Write #1, EndNum
Write #1, UserForm1.TxtPref
Write #1, UserForm1.TxtSuff
Write #1, ICt
Write #1, HgtFact
Close #1

Zeros = "00000000000000000000000000000000000000"

NumVal = UserForm1.TxtStNm
NumDigits = UserForm1.TxtLd0s

Dim Session As String

Open "C:\1Storage\DoNotDelete\AutoCode\Session.txt" For Input As #1
Input #1, Session
Close #1

If Session = "New" Then
Open "C:\1Storage\DoNotDelete\AutoCode\AutoBarCodeNum.txt" For Output As #1
Write #1, NumVal
Close #1
Counter = 0
End If

Open "C:\1Storage\DoNotDelete\AutoCode\AutoBarCodeNum.txt" For Input As #1
Input #1, NumVal
Close #1

If Session = "Current" Then
Open "C:\1Storage\DoNotDelete\AutoCode\Counter.txt" For Input As #1
Input #1, Counter
Close #1
End If

Counter = Counter

Dim HgtFactRd As Double
HgtFactRd = HgtFact / 100

For b = 1 To UserForm1.TxtNumUp
    's.Move -GapAcc, 0
    For a = 1 To UserForm1.TxtNumAcc
            'Move Main object XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            s.Move GapAcc, 0
            PositionX = s.PositionX
            PositionY = s.PositionY
            'Move Main object XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            
            'Create Numbers XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            NumVal = NumVal
            LenNum = Len(Str(NumVal)) - 1
            AddDigit = NumDigits - LenNum
            If AddDigit < 0 Then
            AddDigit = 0
            End If
            NumLead = Left(Zeros, AddDigit)
            NumStrWrite = UserForm1.TxtPref & NumLead & NumVal & UserForm1.TxtSuff
            NumVal = NumVal + 1
            'Create Numbers XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            
            'Create Bar Code XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            Set MyData = New DataObject
            MyData.SetText NumStrWrite
            MyData.PutInClipboard
            With CorelScript
            .InsertOLEObject "CorelBARCODE.10"
            .OLEObjectDoVerb 0
            End With
            
            SendKeys "^{V}", True 
            SendKeys "{ENTER}", True
            SendKeys "{ENTER}", True
            SendKeys "{ENTER}", True
            
            ActiveShape.Cut
            With CorelScript
            .PasteSystemClipboardFormat 3 'pastes as metafile to convert bar code to curves
            End With
            ActiveSelection.Ungroup
            'Create Bar Code XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            
            'Position Bar Code XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            Set SBarC = ActiveSelection
            SBarC.SetPosition (PositionX - PosDifX), (PositionY - PosDifY)
            SBarC.GetSize BarcX, BarcY
            SBarC.SetSize BarcX, (BarcY * HgtFactRd)
            Set SBarC = Nothing
            'Position Bar Code XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            
            s.Duplicate
            Counter = Counter + 1
    Next a
s.Move -(GapAcc * UserForm1.TxtNumAcc), -GapUp
Next b
s.Delete
Set s = Nothing

    For Each s In ActivePage.Shapes
        If s.Fill.Type = cdrUniformFill Then
           With s.Fill.UniformColor
                If .RGBRed = 0 And .RGBGreen = 0 And .RGBBlue = 0 Then
                s.Fill.UniformColor.CMYKAssign 0, 0, 0, 100
                ElseIf .RGBRed = 255 And .RGBGreen = 255 And .RGBBlue = 255 Then
                s.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
                End If
            End With
        End If
    Next s


Open "C:\1Storage\DoNotDelete\AutoCode\Counter.txt" For Output As #1
Write #1, Counter
Close #1

Open "C:\1Storage\DoNotDelete\AutoCode\AutoBarCodeNum.txt" For Output As #1
Write #1, NumVal
Close #1

Open "C:\1Storage\DoNotDelete\AutoCode\Session.txt" For Output As #1
Write #1, "Current"
Close #1

If Counter > UserForm1.TxtEnNm Then
MsgBox "Job Complete"
End If

SendKeys "{NUMLOCK}", True
SendKeys "{NUMLOCK}", True

NmLen = Len(DocNm)
NmLen = NmLen - 4
DocNm = Left(DocNm, NmLen) 'ok
NmLen = InStrRev(DocNm, "\", -1, vbTextCompare)
DocNm = Right(DocNm, (NmLen + 1))
FileNm = "C:\1Storage\AutoCode\" & DocNm & " " & Counter & ".cdr"
  
With CorelScript
    .SelectAllObjects
    .Group
    .AlignToCenterOfPage 3, 3
    .FileSave FileNm, 1, 0, 3, -1
End With

Unload UserForm1


End Sub

Eh eh, that old one - bit rough and ready that one!

I'm still using this with great success in Corel 10. Saves heaps of time.

If the original poster would like more detail along with the Forms and code for the UI I'm happy to help.

But they may be able to glean the method I used to generate the barcodes from the link you have posted.

In this case the barcode numbers are read from a text file.

I suggest you use iwinsoft Barcode Generator