Iceberg Code

Thank you visiting ICB - Iceberg Code Blog
This is the place, where I'd like to share ideas and some useful code (VB, Excel, T-SQL, JavaScript, ...)
Table of Content

It could happen one day that you need to print a Barcode.
Well in the Barcode.xls files you can get all you need to do it within Excel.

First you need to install the Barcode Fonts (in the file you find them - "Free 3 of 9" & "Free 3 of 9 Extended" The origin of the fonts could be lost)

How To add a new font to your computer?

1. Click Start, point to Settings, click Control Panel, and then double-click Fonts.
2. On the File menu, click Install New Font.
3. Click the drive, and then click the folder that contains the fonts you want to add.
4. Click the font you want to add.

Notes
* To select more than one font to add, hold down the CTRL key, and then click each of the fonts you want.

* For TrueType, Raster, or Adobe Type 1 fonts, you can also add the font by dragging the appropriate files to the Fonts folder. If you want to see the file extensions in Windows Explorer, click View, click Options, and then click the View tab. Click to clear the Hide file extensions for known file types check box. This works only for fonts that are not in the Fonts folder.


Now you are ready to translate all your code in a Barcode, but before you have to add a checksum to your original code. To do this you'll find 3 function that calculate the correct code: Append_EAN_Checksum, Format_Code128 and Format_UPC_String

Download it now
As usual if you prefer to read the code you can do it below:

'EAN -13 'EAN-13 is used world-wide for marking retail goods. 'The symbol encodes 13 characters: the first two or three are a country code which 'identify the country in which the manufacturer is registered (not necessarily where 'the product is actually made). The country code is followed by 9 or 10 data digits '(depending on the length of the country code) and a single digit checksum. 2-digit 'and 5-digit supplemental barcodes may be added for a total of 14 or 17 data digits. ' 'The Uniform Code Council (the organization which issues retail codes in the USA) 'has announced that January 1, 2005 will be the date by which all retail scanning 'systems in the USA must be able to accept the EAN-13 symbol as well as the standard 'UPC-A. This change will eliminate the need for manufacturers who export goods to 'the US and Canada to double-label their products. ' 'The checksum is a Modulo 10 calculation: ' Add the values of the digits in the even-numbered positions: 2, 4, 6, etc. Multiply this result by 3. Add the values of the digits in the odd-numbered positions: 1, 3, 5, etc. Sum the results of steps 2 and 3. The check character is the smallest number which, when added to the result in step4, produces a multiple of 10. Example: Assume the barcode data = 001234567890 0 + 2 + 4 + 6 + 8 + 0 = 20 20 * 3 = 60 0 + 1 + 3 + 5 + 7 + 9 = 25 60 + 25 = 85 85 + X = 90 (nearest equal or higher multiple of 10), therefore X = 5 (checksum) Here is a sample Visual Basic function to calculate the checksum: Function Append_EAN_Checksum(RawString As String)      Dim Position As Integer      Dim Checksum As Integer      Checksum = 0      For Position = 2 To 12 Step 2            Checksum = Checksum + Val(Mid$(RawString, Position, 1))      Next Position      Checksum = Checksum * 3      For Position = 1 To 11 Step 2            Checksum = Checksum + Val(Mid$(RawString, Position, 1))      Next Position      Checksum = Checksum Mod 10      Checksum = 10 - Checksum      If Checksum = 10 Then            Checksum = 0      End If      Append_EAN_Checksum = RawString & Format$(Checksum, "0") End Function 'Calculating a Code 128 Barcode Checksum in Access Basic 'This bit of Access Basic (same as Visual Basic) will calculate a Code 128 Modulo 103 checksum. 'Barcode fonts from different publishers may map the some characters to 'different locations, so be sure to check. Function Format_Code128(InString As String) As String      Dim Sum As Integer, i As Integer      Dim Checksum As Integer, Checkchar As Integer      Dim MyString As String, CVal As Integer      '      ' Initialize running total with value of      ' Subset B start character      '      Sum = 104      '      ' Scan the string and add character value times position      '      For i = 1 To Len(InString)          '          ' Copy one character from InString position i to MyString          '          MyString = Mid$(InString, i, 1)          '          ' Get the numeric value of the character and subtract          ' 32 to shift (the space character, ASCII value 32, has          ' a numeric value of 0 as far as Code 128 is concerned)          '          CVal = Asc(MyString) - 32          '          ' Add the weighted value into the running sum          '          Sum = Sum + (CVal * i)      Next i      '      ' Calculate the Modulo 103 checksum      '      Checksum = Sum Mod 103      '      ' Now convert this number to a character. This conversion      ' takes into account the particular mapping of the font      ' being used (this example is for the font published by      ' Azalea Software.      '      If CheckDigit = 0 Then          Checkchar = 174      ElseIf CheckDigit < 94 Then          Checkchar = CheckDigit + 32      Else          Checkchar = CheckDigit + 71      End If      '      ' Now format the final output string: start character,      ' data, check character, and stop character      '      MyString = Chr(162) + InString + Chr(Checkchar) + Chr(164)      Format_Code128 = MyString End Function 'UPC retail codes require a Modulo 10 check digit. 'This sample code accepts the UPC number, calculates the check digit, 'and returns the finished string. ' 'The general method involves adding up the digits in the odd-numbered 'positions and multiplying that sum by 3; then adding to that result 'the values of the digits in the even-numbered positions. 'Divide this result by 10 and subtract the remainder from 10. 'If the result is equal to 10, set it to zero; otherwise this is the check digit. Function Format_UPC_String(InString As String) As String      Dim OutString As String      Dim Multiplier As Integer, Sum As Integer, i As Integer      Dim CheckDigit As Integer      '      ' Initialize the sum to zero      '      Sum = 0      '      ' Add up the values of digits in the odd-numbered positions      '      For i = 1 To Len(InString) Step 2          Sum = Sum + Val(Mid$(InString, i, 1))      Next i      '      ' Multiply this result by 3, then add in the values of      ' the digits in the even-numbered positions      '      Sum = Sum * 3      For i = 2 To Len(InString) Step 2          Sum = Sum + Val(Mid$(InString, i, 1))      Next i      '      ' Now calculate the Modulo 10 check digit      '      CheckDigit = Sum Mod 10      CheckDigit = 10 - CheckDigit      If CheckDigit = 10 Then          CheckDigit = 0      End If      OutString = InString + Format$(CheckDigit)      Format_UPC_String = OutString End Function

This is a function to translate any String in Morse Code,
I don't know if it is a useful function, but if you are
starting to study VBA, it's a nice code to read

Function txt2morse(ByVal text As String) As String Dim Letters As String, Morse As String, arrMorse() As String, i As Long     Letters = " ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.,?/:"     Morse = " ,.-,-...,-.-.,-..,.,..-.,--.,....,..,.---,-.-,.-..,--,-.,---,.--.,--.-,.-.,...,-,..-,...-,.--,-..-,-.--,--..,-----,.----,..---,...--,....-,.....,-....,--...,---..,----.,.-.-.-,--..--,..--..,-..-. ,-...-"     arrMorse = Split(Morse, ",")     text = UCase(text)     For i = 1 To Len(text)         txt2morse = txt2morse & " " & arrMorse(InStr(1, Letters, Mid(text, i, 1)) - 1)     Next     txt2morse = Trim(txt2morse) End Function

I started programming at school for an exam, and I thought all I need was to pass it. That's was right, but when I started working I couldn't get enough to be just a small end-user who have to thanks any junior or (pseudo)senior programmer telling me that all can be done, but ... they never did.

One day my father teach me that:
"If a stupid more stupid than you did it, why can't you get it?"

This was for my driving licence, but till now it worked out for almost anything.
Maybe I could write the first "one row" self help book with this phrase. I'll think about it!

... so I started use Excel and all its functions, but it wasn't enough, I wanted more, so I re-started learning programming.

How to learn?
Well I did some macro recording, but the code was not flexible enough so I pick a book with some VBA Examples (Laboratorio di VBA)
It was not enough ...
So I got the Walkenbach bible (in French) Excel 2000 - programmer avec VBA

It was enough! from now on, to get more I had to browse the web and to do my own.
It's always a matter of equilibrium:
What you should let excel do and when let VBA start play.
How to organise your data and your spreadsheet.
This is just a matter of experience (stratified error)

Just to better illustrate my point of view I've been a little far from VBA to VB with Balena (Programming Microsoft Visual Basic 6.0)
But after a little bit of hesitation I come back to Excel and VBA because I usually be the end-user of my creation so I need just a flexible tool fast, quick and ... clean.

If you start build your own forms with VB you get creasy counting pixels to arrange all the objects you put on it, and after all I don't want to rebuild Excel to manipulate the output/input.

Know I feel comfortable with VBA, SQL, Javascript, HTML and of course Excel,
and I have to thank all the author of books and web site,
with a special thank to Joel Spolsky
... but maybe, most of all I should thank all the people who ask and answer groups!


Thank you

It's easy because the Excel worksheet protection is not very strong.

For some people this a bug, for me it is ok, because I use protection
just to prevent end-user destruction! ... If You know what I mean.

So you can put any kind of password and forget it, because with
the code I post now you are no more in trouble.

personally I like this pwd "sdsadsadsdssdadadasdsadsadasdasdas"
(you can break with "AAAAAABBBBAe")

This code is not mine it comes from Aaron T. Blood web page
www.xl-logic.com/pages/vba.html
here the file (the original one):
password_hack.xls
After reading the code don't tell me that programming is not a kind of magic!

This is my first occasion to thank all the smart guy out there that likes to share
their knowledge!
Here's the code (I don't understand ... but I adapt myself):

Sub breakit() Dim i As Integer, j As Integer, k As Integer, Dim l As Integer, m As Integer, n As Integer On Error Resume Next For i = 65 To 66 For j = 65 To 66 For k = 65 To 66 For l = 65 To 66 For m = 65 To 66 For i1 = 65 To 66 For i2 = 65 To 66 For i3 = 65 To 66 For i4 = 65 To 66 For i5 = 65 To 66 For i6 = 65 To 66 For n = 32 To 126 ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & _   Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Application.StatusBar = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & _   Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If ActiveSheet.ProtectContents = False Then MsgBox "One useble password is " & Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & _   Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Exit Sub End If Next Next Next Next Next Next Next Next Next Next Next Next End Sub

In previous post you selected unique files (ANY) and now you'd like
to search inside all the beautiful VBA code you written or you got there
or elsewhere.

For this reason I found a elegant solution on the web and
I improved a little (I just put an interface to it)

ExportCode.xls

Note: to use this particular macro you have to change
an Excel setting (if you don't you'll get nothing):

So just follow the Excels Menus
[Tools][Macro][Security...] to [Trusted Sources]
and activate "Trust access to Visual Basic Project"

After you run it you get a lot of *.cod files and maybe
you'd like to merge all them to better search inside with
a text editor (I use ultraedit).

To do this you just need a simple batch file:
copy and paste this one-row code in a file you call "Merge.bat"

copy *.cod Merged.txt

... and run it, now you have a big file with all your VBA code to search inside!

In the last post I uploaded a spreadsheet to search all files in your PC
but now you got too many files, and if you are like me (I never throw away a
file and I do some kind of confusing versioning) you can get lost quick to find
latest version.

I've been looking around, but I didn't find anything that fit my needs, so
as usual I did my own.

Compare two files and decide if they are identical it's a kind of art
(without open them). I remarked that 2 identical files can be different
in byte comparing just because one has been closed with cell A1 selected
and another with cell B2 ...

So comparing them just byte by byte it's not enough.
For this reason I personally consider identical files with same lenght
and 98% or more bytes identical ...

I did 2 functions, the first to know if 2 file are 100% identical
and the second to know how much they are similar

If you don't like to read code, but you need just a solution
please download it know: File_Move_Rename.xls

Remarks that in the spreadsheet there are other functions:
FileMoveFile, FileDeleteFile, FolderCreate, FolderExists, ...

So first you need a simple code to compare files
Here's the code (ops ... comments are in Italian):

Sub testFileBynaryCompare() Dim BinaryFile1, BinaryFile2, MyStart, MyResult      BinaryFile1 = "c:\P4.html"      BinaryFile2 = "c:\p3.html"      MyStart = Now      MyResult = FileBynaryCompare(BinaryFile1, BinaryFile2)      MsgBox (Now - MyStart) * 86400 * 1000000000 / FileLen(BinaryFile1) & " sec / giga"      MsgBox MyResult End Sub Function FileBynaryCompare(ByVal BinaryFile1 As String, ByVal BinaryFile2 As String) As Boolean ' funzione che verifica se 2 file sono uguali per ogni singolo byte ' verifico che i file esistono      If (Len(Dir(BinaryFile1)) = 0) Then GoTo ExitFunction      If (Len(Dir(BinaryFile2)) = 0) Then GoTo ExitFunction 'verifico che abbiano dimensioni uguali      If FileLen(BinaryFile1) <> FileLen(BinaryFile2) Then GoTo ExitFunction ' dimensione della stringa estratta Dim BYTE_SIZE BYTE_SIZE = 5000 Dim StrVar1 As String * 5000 Dim StrVar2 As String * 5000 Dim FileNum1, FileNum2, i ' Apro il primo file FileNum1 = FreeFile Open BinaryFile1 For Binary Access Read As #FileNum1 ' Apro il secondo file FileNum2 = FreeFile Open BinaryFile2 For Binary Access Read As #FileNum2 'confronto 5000 byte alla volta i = 1 Do Until EOF(FileNum1)      Get #FileNum1, i, StrVar1      Get #FileNum2, i, StrVar2          If StrVar1 <> StrVar2 Then GoTo ExitFunction      i = i + BYTE_SIZE Loop ' se sono arrivato qui vuol dire che sono uguali FileBynaryCompare = True ExitFunction: Close #FileNum1 Close #FileNum2 End Function

But, if the too files are similar for 99% you don't
get the result you expect so with a little modification
you can get a better result

Sub testFileSimilitude() Dim BinaryFile1, BinaryFile2, MyStart, MyResult      BinaryFile1 = "c:\P4.html"      BinaryFile2 = "c:\p3.html"      MyStart = Now      MyResult = FileSimilitude(BinaryFile1, BinaryFile2)      MsgBox (Now - MyStart) * 86400 * 1000000000 / FileLen(BinaryFile1) & " sec / giga"      MsgBox MyResult End Sub Function FileSimilitude(ByVal BinaryFile1 As String, ByVal BinaryFile2 As String) As Single ' funzione che verifica se 2 file sono uguali per ogni singolo byte ' verifico che i file esistono      If (Len(Dir(BinaryFile1)) = 0) Then GoTo ExitFunction      If (Len(Dir(BinaryFile2)) = 0) Then GoTo ExitFunction 'verifico che abbiano dimensioni uguali Dim FileLen1      FileLen1 = FileLen(BinaryFile1)      If FileLen1 <> FileLen(BinaryFile2) Then GoTo ExitFunction If FileBynaryCompare(BinaryFile1, BinaryFile2) = True Then FileSimilitude = 1 GoTo ExitFunction End If ' dimensione della stringa estratta Dim BYTE_SIZE BYTE_SIZE = 5000 Dim StrVar1 As String * 5000 Dim StrVar2 As String * 5000 Dim FileNum1, FileNum2, i, k, j As Single ' Apro il primo file FileNum1 = FreeFile Open BinaryFile1 For Binary Access Read As #FileNum1 ' Apro il secondo file FileNum2 = FreeFile Open BinaryFile2 For Binary Access Read As #FileNum2 'confronto 5000 byte alla volta i = 1 j = 0 Do Until EOF(FileNum1) Get #FileNum1, i, StrVar1 Get #FileNum2, i, StrVar2 If StrVar1 <> StrVar2 Then For k = 1 To Len(StrVar1) If Mid(StrVar1, k, 1) <> Mid(StrVar2, k, 1) Then j = j + 1 If j > FileLen1 / 20 Then GoTo ExitFunction Next End If i = i + BYTE_SIZE Loop ' se sono arrivato qui vuol dire che sono uguali If FileLen1 = 0 Then FileSimilitude = 1 Else FileSimilitude = (FileLen(BinaryFile1) - j) / FileLen(BinaryFile1) End If ExitFunction: Close #FileNum1 Close #FileNum2 End Function

Remark that Function FileSimilitude is a lot slower than FileBynaryCompare