OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > Code Critique

Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
Old 21-07-2004, 00:22
Posts: n/a
Default 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
            s.Move GapAcc, 0
            PositionX = s.PositionX
            PositionY = s.PositionY
            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
            Set MyData = New DataObject
            MyData.SetText NumStrWrite
            With CorelScript
            .InsertOLEObject "CorelBARCODE.10"
            .OLEObjectDoVerb 0
            End With
            SendKeys "^{V}", True 
            SendKeys "{ENTER}", True
            SendKeys "{ENTER}", True
            SendKeys "{ENTER}", True
            With CorelScript
            .PasteSystemClipboardFormat 3 'pastes as metafile to convert bar code to curves
            End With
            Set SBarC = ActiveSelection
            SBarC.SetPosition (PositionX - PosDifX), (PositionY - PosDifY)
            SBarC.GetSize BarcX, BarcY
            SBarC.SetSize BarcX, (BarcY * HgtFactRd)
            Set SBarC = Nothing
            Counter = Counter + 1
    Next a
s.Move -(GapAcc * UserForm1.TxtNumAcc), -GapUp
Next b
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
    .AlignToCenterOfPage 3, 3
    .FileSave FileNm, 1, 0, 3, -1
End With

Unload UserForm1

End Sub
Reply With Quote

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
HOW-TO call coreldraw12 find dialog from VBA code???? wOxxOm CorelDRAW/Corel DESIGNER VBA 4 02-03-2008 08:32
Text ENCODE Craig Tucker CorelDRAW/Corel DESIGNER VBA 10 26-01-2005 13:59
How to use events from CorelDRAW.Document in my code? me CorelDRAW/Corel DESIGNER VBA 2 30-10-2004 02:49
Simple Loop? dan CorelDRAW/Corel DESIGNER VBA 3 13-10-2004 13:31
How can I extract a piece of a bitmap object using VBA code oswaldon Corel Photo-Paint VBA 2 25-04-2004 19:37

All times are GMT -5. The time now is 05:12.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2023, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com