garimpei esta função na net mas ela só sunciona no picturebox, se alguem quiser testala...

 

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(LF_FACESIZE) As Byte 'THIS WAS DEFINED IN API-CHANGES MY OWN
  lfFaceName As String * 33
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

'Para poder usar esse efeito use a seguinte função

Public Sub EscreverString(Objeto As Object, gString As String, Fonte As String, Tamanho As String, Angulo As String, LocalX As Long, LocalY As Long)
 
  On Error GoTo GetOut
 
  Dim f As LOGFONT, hPrevFont As Long, hFont As Long, FontName As String
  Dim FONTSIZE As Integer
  FONTSIZE = Val(Tamanho)

  f.lfEscapement = 10 * Val(Angulo)
  FontName = Fonte + Chr$(0)
  f.lfFaceName = FontName
  f.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
  hFont = CreateFontIndirect(f)
  hPrevFont = SelectObject(Objeto.hDC, hFont)
  Objeto.CurrentX = LocalX
  Objeto.CurrentY = LocalY
  Objeto.Print gString

  hFont = SelectObject(Objeto.hDC, hPrevFont)
  DeleteObject hFont

  Exit Sub
GetOut:
  Exit Sub

End Sub