Code for making QSL labels thru a pdf-driver, set to A4 paper and 150 dpi.

Type POINTAPI
 X As Long
 Y As Long
End Type
Public lpPoint As POINTAPI
Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpstring As String, ByVal ncount As Long) As Long


Private Sub Command1_Click()

Dim Apu1 As Long
' get the printer device number
Apu1 = CLng(Printer.hdc)
Printer.DrawMode = 13
Printer.ForeColor = RGB(0, 0, 0)
Printer.DrawStyle = 1
Printer.FillStyle = 1
' open the log file
Open "c:\temp\oh5sm.csv" For Input As 1
' set steps for the labels in XY coords of the A4 sized paper (150 Dpi, pdf-driver)
LabelXstep = (Printer.ScaleWidth / 4.1) / Printer.TwipsPerPixelY
LabelYstep = (Printer.ScaleHeight / 9.2) / Printer.TwipsPerPixelY
' Apply some marginal
Xmarg = (LabelXstep * 0.05)
Ymarg = (LabelYstep * 0.1)
' Initialize the printer,
Dim lpPoint As POINTAPI
Printer.Line (1, 1)-(2, 2)
labels = 1: QNR = 0
' declare the variables in the log
Dim SerailNR As Long, Freq As Long, Qday As Long, Qmonth As String, Qyear As Long
Dim Qtime As String, QCall As String, LastItem As Long
' Strings for 8 QSOs, hold the Freq & UTC
Dim Qlines(1 To 8) As String
 For j = 1 To 8
   Qlines(j) = "----- -----"
 Next j

Rem *************** MAIN LOOP THRU the log ***********
' Loop the csv file
Do Until (EOF(1))
' Each A4 will have 36 labels
Do While (labels <= 36) ' Each A4 will hold 9 x4 labels
' For the first label, draw the lines separating the labels
 If labels = 1 Then
  For i = LabelXstep To LabelXstep * 3 + 20 Step LabelXstep
   apu = MoveToEx(ByVal Apu1, ByVal CLng(Xmarg + i), ByVal CLng(Ymarg + 1), lpPoint)
   apu = LineTo(ByVal Apu1, ByVal CLng(Xmarg + i), ByVal CLng(Printer.ScaleHeight / Printer.TwipsPerPixelY))
  Next i
  For j = LabelYstep To LabelYstep * 8 Step LabelYstep
   apu = MoveToEx(ByVal Apu1, ByVal CLng(Xmarg + 1), ByVal CLng(Ymarg + j), lpPoint)
   apu = LineTo(ByVal Apu1, ByVal CLng(Xmarg + Printer.ScaleWidth / Printer.TwipsPerPixelY), ByVal CLng(Ymarg + j))
  Next j
 End If
 
 ' Read a QSO
 Input #1, SerialNr, Freq, Qday, Qmonth, Qyear, Qtime, QCall, LastItem
 QNR = QNR + 1  ' Qdd the counter of Qsos to this label
 Cline1 = "To radio "
 Cline2 = QCall
 If Freq < 10000 Then Qlines(QNR) = " " & Freq & " " & Qtime
 If Freq > 10000 Then Qlines(QNR) = Freq & " " & Qtime
 
 If LastItem = 1 Then ' It is time to write the label, lastitem = 1 marks that
 Rem Compute the location on the A4 Sheet
 row = (labels + 8) Mod 9
 col = Int((labels - 1) / 9)
 X = col * LabelXstep + Xmarg * 2
 Y = row * LabelYstep + Ymarg * 2
 Printer.FontName = "Lucida Console"
 Printer.FontSize = 8
 Printer.FontBold = False
 apu = MoveToEx(ByVal Apu1, ByVal CLng(X), ByVal CLng(Y), lpPoint)
 Dim apustring As String
 apustring = Cline1 ' "To radio"
 apu = TextOut(ByVal Apu1, ByVal X, ByVal Y, ByVal apustring, ByVal CLng(Len(apustring)))
 apustring = " " & Cline2  ' The callsign
 Printer.FontSize = 14     ' bigger font
 Printer.FontBold = True
 apu = TextOut(ByVal Apu1, ByVal X + 6 * Xmarg, ByVal Y, ByVal apustring, ByVal CLng(Len(Cline2) + 1))
 ' QSO information, Add some lines if there are less Qs
 Add = 0
 If QNR < 7 Then Add = 4 - Int((QNR + 1) / 2)
 ' A small font
 Printer.FontSize = 6
 Printer.FontBold = False
 X = col * LabelXstep + Xmarg * 2
 Y = row * LabelYstep + Ymarg * 3 + (Add * Ymarg) + Ymarg
 apustring = "We confirm 2-way QSOs, RS 59"
 apu = TextOut(ByVal Apu1, ByVal X, ByVal Y, ByVal apustring, ByVal CLng(Len(apustring)))
 X = col * LabelXstep + Xmarg * 2
 Y = row * LabelYstep + Ymarg * 4 + (Add * Ymarg) + Ymarg
 apustring = "in CQWW SSB Contest 2012"
 apu = TextOut(ByVal Apu1, ByVal X, ByVal Y, ByVal apustring, ByVal CLng(Len(apustring)))
 Printer.FontSize = 7
 X = col * LabelXstep + Xmarg * 2
 Y = row * LabelYstep + Ymarg * 5 + (Add * Ymarg) + Ymarg
 apustring = "  kHz  UTC      kHz  UTC "
 Printer.FontUnderline = True
 apu = TextOut(ByVal Apu1, ByVal X, ByVal Y, ByVal apustring, ByVal CLng(Len(apustring)))
 Printer.FontUnderline = False
 For j = 1 To QNR Step 2
  jrow = jrow + 1
  apustring = Qlines(j) & "   " & Qlines(j + 1)
  X = col * LabelXstep + Xmarg * 2
  Y = row * LabelYstep + Ymarg * 6 + (Add * Ymarg) + jrow * Ymarg
  apu = TextOut(ByVal Apu1, ByVal X, ByVal Y, ByVal apustring, ByVal CLng(Len(apustring)))
 Next j
 labels = labels + 1
 For j = 1 To 8
   Qlines(j) = "----- -----"
 Next j
 If labels = 37 Then
   labels = 1
   Printer.NewPage
 End If
 QNR = 0
 End If
Loop
Loop
Printer.EndDoc
Close (1)
End Sub