VB Code In VBA

D

DS

I have this VB6 Code. Is there a way of altering it so that it works in
VBA?
Thanks
DS


Private Sub ButnGetStatus_Click()
Dim rtn As Long 'return value from function call
Dim getstatus As Long 'the status

'get the current printer status
rtn = BiGetStatus(m_hApi, getstatus)
If rtn < 0 Then
ErrMsg (rtn)
Exit Sub
End If

'call function to update the checkboxes with the current status
checkStatus (getstatus)
End Sub


Private Sub ButnPrnt_Click()
Dim Prnt As Printer
Dim nCnt As Integer

'initialize the printer that was chosen
For Each Prnt In Printers
If Prnt.DeviceName = m_PrtN Then
Set Printer = Prnt
Exit For
End If
Next

Dim I As Integer

'Get printer font all data
fntCount = Printer.fontCount
fntCount = 0
nCnt = 0
EnumFontFamilies Printer.hdc, vbNullString, AddressOf
EnumGetFontCount, fntCount
ReDim lstPrnFontTbl(fntCount)
EnumFontFamilies Printer.hdc, vbNullString, AddressOf
EnumGetFontName, nCnt

'Set default title font name
fntTitleName = TITLE_FONTA
For I = 0 To fntCount
' If Printer.Fonts(I) = TITLE_FONTA11 Then
If lstPrnFontTbl(I) = TITLE_FONTA11 Then
fntTitleName = TITLE_FONTA11
Exit For
End If
Next I

'demonstrate the printer fonts
Dim yPos As Integer
Dim tblIdx As Integer
Dim fntIdx As Integer
Dim strTit As String

Printer.Print
Printer.CurrentY = 0
Printer.ScaleMode = PIXELS

Screen.MousePointer = 11
Printer.font.name = fntTitleName
Printer.font.Size = 10

'print the title
Printer.Print PRINT_TITLE_NAME
Printer.CurrentY = Printer.CurrentY + 6
Printer.Print "Print Font Sample"
Printer.CurrentY = Printer.CurrentY + 50
nPrnYPos = Printer.CurrentY

'call the funtion to print a font sample
For tblIdx = 0 To (lstPrnFontCount - 1)
For fntIdx = 0 To fntCount
If lstPrnFontTbl(fntIdx) = lstPrnFont(tblIdx).name Then
Call PrintFontSub(lstPrnFont(tblIdx).name,
lstPrnFont(tblIdx).Size)
Exit For
End If
Next fntIdx
Next tblIdx

Printer.EndDoc
Screen.MousePointer = 0

End Sub
 
D

Douglas J Steele

I think Access 2002 supports the Printers collection, but I'm not sure
(don't have 2002 installed here).

It may be that you need to use

For Each Prnt In Application.Printers

rather then

For Each Prnt In Printers
 
D

DS

Douglas said:
I think Access 2002 supports the Printers collection, but I'm not sure
(don't have 2002 installed here).

It may be that you need to use

For Each Prnt In Application.Printers

rather then

For Each Prnt In Printers
Click to expand...
I'll give it a try.
Thanks
DS
 
D

DS

Douglas said:
I think Access 2002 supports the Printers collection, but I'm not sure
(don't have 2002 installed here).

It may be that you need to use

For Each Prnt In Application.Printers

rather then

For Each Prnt In Printers
Click to expand...
Ok Tried this but still having problems.....

Private Sub ButnPrnt_Click()
Dim Prnt As Printer
Dim nCnt As Integer

'initialize the printer that was chosen
For Each Prnt In Application.Printers
If Prnt.DeviceName = m_PrtN Then
Set Application.Printer = Prnt
Exit For
End If
Next

Dim I As Integer

'Get printer font all data
fntCount = Application.Printer.fontCount
fntCount = 0
nCnt = 0
EnumFontFamilies Application.Printer.hdc, vbNullString, AddressOf
EnumGetFontCount, fntCount
ReDim lstPrnFontTbl(fntCount)
EnumFontFamilies Application.Printer.hdc, vbNullString, AddressOf
EnumGetFontName, nCnt

'Set default title font name
fntTitleName = TITLE_FONTA
For I = 0 To fntCount
If Application.Printer.Fonts(I) = TITLE_FONTA11 Then
If lstPrnFontTbl(I) = TITLE_FONTA11 Then
fntTitleName = TITLE_FONTA11
Exit For
End If
Next I

'demonstrate the printer fonts
Dim yPos As Integer
Dim tblIdx As Integer
Dim fntIdx As Integer
Dim strTit As String

Application.Printer.Print
Application.Printer.CurrentY = 0
Application.Printer.ScaleMode = PIXELS

Screen.MousePointer = 11
Application.Printer.font.name = fntTitleName
Application.Printer.font.Size = 10

'print the title
Application.Printer.Print PRINT_TITLE_NAME
Application.Printer.CurrentY = Printer.CurrentY + 6
Application.Printer.Print "Print Font Sample"
Application.Printer.CurrentY = Application.Printer.CurrentY + 50
nPrnYPos = Application.Printer.CurrentY

' 'call the funtion to print a font sample
For tblIdx = 0 To (lstPrnFontCount - 1)
For fntIdx = 0 To fntCount
If lstPrnFontTbl(fntIdx) = lstPrnFont(tblIdx).name Then
Call PrintFontSub(lstPrnFont(tblIdx).name,
lstPrnFont(tblIdx).Size)
Exit For
End If
Next fntIdx
Next tblIdx
'
Printer.EndDoc
Screen.MousePointer = 0
'
End Sub


This won't compile. Things like FontCount won't go thru.
Thanks
DS
 
D

DS

DS said:
Ok Tried this but still having problems.....

Private Sub ButnPrnt_Click()
Dim Prnt As Printer
Dim nCnt As Integer

'initialize the printer that was chosen
For Each Prnt In Application.Printers
If Prnt.DeviceName = m_PrtN Then
Set Application.Printer = Prnt
Exit For
End If
Next

Dim I As Integer

'Get printer font all data
fntCount = Application.Printer.fontCount
fntCount = 0
nCnt = 0
EnumFontFamilies Application.Printer.hdc, vbNullString, AddressOf
EnumGetFontCount, fntCount
ReDim lstPrnFontTbl(fntCount)
EnumFontFamilies Application.Printer.hdc, vbNullString, AddressOf
EnumGetFontName, nCnt

'Set default title font name
fntTitleName = TITLE_FONTA
For I = 0 To fntCount
If Application.Printer.Fonts(I) = TITLE_FONTA11 Then
If lstPrnFontTbl(I) = TITLE_FONTA11 Then
fntTitleName = TITLE_FONTA11
Exit For
End If
Next I

'demonstrate the printer fonts
Dim yPos As Integer
Dim tblIdx As Integer
Dim fntIdx As Integer
Dim strTit As String

Application.Printer.Print
Application.Printer.CurrentY = 0
Application.Printer.ScaleMode = PIXELS

Screen.MousePointer = 11
Application.Printer.font.name = fntTitleName
Application.Printer.font.Size = 10

'print the title
Application.Printer.Print PRINT_TITLE_NAME
Application.Printer.CurrentY = Printer.CurrentY + 6
Application.Printer.Print "Print Font Sample"
Application.Printer.CurrentY = Application.Printer.CurrentY + 50
nPrnYPos = Application.Printer.CurrentY

' 'call the funtion to print a font sample
For tblIdx = 0 To (lstPrnFontCount - 1)
For fntIdx = 0 To fntCount
If lstPrnFontTbl(fntIdx) = lstPrnFont(tblIdx).name Then
Call PrintFontSub(lstPrnFont(tblIdx).name,
lstPrnFont(tblIdx).Size)
Exit For
End If
Next fntIdx
Next tblIdx
'
Printer.EndDoc
Screen.MousePointer = 0
'
End Sub


This won't compile. Things like FontCount won't go thru.
Thanks
DS
Click to expand...
Better yet, Does this code return anything other that printing the
available fonts? Like printer status or anything like that?
Thanks
DS
 
D

Douglas J Steele

DS said:
Better yet, Does this code return anything other that printing the
available fonts? Like printer status or anything like that?
Click to expand...

Looks like it only prints fonts.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

(no subject) 0
VBA Coding Help for Beginner 0
Need help modifying code 0
ListIndex Incorrect 5
VB and VBA 0
Code Is Slow 3
Code Is Slow 6
Code Stopped Working 1

Top