Option Explicit
Private Const LF_FACESIZE = 32
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * LF_FACESIZE
End Type

Private Type DOCINFO
cbSize As Long
lpszDocName As String
lpszOutput As String
lpszDatatype As String
fwType As Long
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private 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 ' or Boolean
Private Declare Function StartDoc Lib "gdi32" Alias "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long
Private Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) As Long
Const DESIREDFONTSIZE = 12

Private Sub Command1_Click()

' Combine API Calls with the Printer object
Dim OutString As String
Dim lf As LOGFONT
Dim result As Long
Dim hOldfont As Long
Dim hPrintDc As Long
Dim hFont As Long

Printer.Print "Vanlig text via printerobjektet"
hPrintDc = Printer.hdc
OutString = "Roterad via printerobjektet"
lf.lfEscapement = 900
lf.lfHeight = (DESIREDFONTSIZE * -20) / Printer.TwipsPerPixelY
hFont = CreateFontIndirect(lf)
hOldfont = SelectObject(hPrintDc, hFont)
result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))
result = SelectObject(hPrintDc, hOldfont)
result = DeleteObject(hFont)
Printer.EndDoc

' Print using API calls only
Dim di As DOCINFO 'Structure for Print Document info

OutString = "Roterad text via API"

' Set rotation in tenths of a degree, i.e., 1800 = 180 degrees
lf.lfEscapement = 900
lf.lfHeight = (DESIREDFONTSIZE * -20) / Printer.TwipsPerPixelY
hFont = CreateFontIndirect(lf) 'Create the rotated font
di.cbSize = 20 ' Size of DOCINFO structure
di.lpszDocName = "My Document" ' Set name of print job (Optional)

' Create a printer device context
hPrintDc = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)

result = StartDoc(hPrintDc, di) 'Start a new print document
result = StartPage(hPrintDc) 'Start a new page

' Select our rotated font structure and save previous font info
hOldfont = SelectObject(hPrintDc, hFont)

' Send rotated text to printer, starting at location 1000, 1000
result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))

' Reset font back to original, non-rotated
result = SelectObject(hPrintDc, hOldfont)

' Send non-rotated text to printer at same page location
OutString = "Vanlig text via API"
result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))

result = EndPage(hPrintDc) 'End the page
result = EndDoc(hPrintDc) 'End the print job
result = DeleteDC(hPrintDc) 'Delete the printer device context
result = DeleteObject(hFont) 'Delete the font object
End Sub