View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Shahin Musayev Shahin Musayev is offline
external usenet poster
 
Posts: 18
Default Font.Bold Property slows down macro

Ok, thanx everyone. I think i resolved my problem :) Switching
printers do the trick.
Code without switching printers is executed for 4.75 seconds, code
with printers switching is executed for 0.3 seconds!!!

Now code looks like this:

With wshRNSheet.Range("A1:F1")
Call SwitchDefaultPrinter
.Font.Bold = True 'this line is reason for delay
Call SwitchDefaultPrinter (True)
End With 'wshRNSheet.Range("A1:F1")


Routine SwitchDefaultPrinter is written based on article
http://support.microsoft.com/default...b;en-us;266767
Routine code follows (hope this will be helpful). Please correct me if
I did something wrong:



Sub SwitchDefaultPrinter(Optional ByVal blnOn As Boolean = False)

Dim lngResult As Long
Dim strBuffer As String

Dim udtOsInfo As OSVERSIONINFO

Static strDPrinterName As String

Dim strPrinterName As String
Dim strDiverName As String
Dim strPrinterPort As String
Dim strDeviceLine As String

Const lngMAX_CHARS As Long = 1024

Const strDOCUMENT_WRITER As String = "Microsoft Office Document
Image Writer"
Const strCOMMA As String = ","


' Check if variable contains Default Printer name from previous
call
If LenB(strDPrinterName) = 0 Then
' If we need to Swith Default Printer On (return previous one)
we have an error
If blnOn Then
' code to handle error goes here
Exit Sub
Else
' Get default printer from WIN.INI
strBuffer = Space$(lngMAX_CHARS)
lngResult = GetProfileString("Windows", "Device",
vbNullString, strBuffer, lngMAX_CHARS)

strDPrinterName = Split(Left$(strBuffer, lngResult),
strCOMMA)(0)
End If
End If



If blnOn Then
' Switch default printer to printer which was selected
previously
strPrinterName = strDPrinterName
Else
' Switch default printer to "Microsoft Office Document Image
Writer"
strPrinterName = strDOCUMENT_WRITER
End If



' Get OS Version
udtOsInfo.dwOSVersionInfoSize = 148
udtOsInfo.szCSDVersion = Space$(128)

lngResult = GetVersionExA(udtOsInfo)

If udtOsInfo.dwPlatformId = lngVER_PLATFORM_WIN32_WINDOWS Then

' Code for win95 follows
' I skipped this part. Use this article to fill a gap.
' http://support.microsoft.com/default...b;en-us;266767

Else
' This assumes that future versions of Windows use the NT method

' Get the printer information for the currently selected
' printer in the list. The information is taken from the
' WIN.INI file.
strBuffer = Space$(lngMAX_CHARS)
lngResult = GetProfileString("PrinterPorts", strPrinterName,
vbNullString, strBuffer, lngMAX_CHARS)

strBuffer = Left$(strBuffer, lngResult)

' Driver Name goes first and Printer Port goes second
If UBound(Split(strBuffer, strCOMMA)) < 1 Then
' code to handle error goes here
Exit Sub
Else
strDiverName = Split(strBuffer, strCOMMA)(0)
strPrinterPort = Split(strBuffer, strCOMMA)(1)
End If

' Check if we have all info
If LenB(strDiverName) = 0 Or LenB(strPrinterPort) = 0 Then
' code to handle error goes here
Exit Sub
Else
' Store the new printer information in the [WINDOWS]
section of
' the WIN.INI file for the DEVICE
strDeviceLine = strPrinterName & strCOMMA & strDiverName &
strCOMMA & strPrinterPort

lngResult = WriteProfileString("Windows", "Device",
strDeviceLine)

End If

End If

' Make sure Printer object is set to the new printer
If Printer.DeviceName < strPrinterName Then

Dim Prt As Printer

For Each Prt In Printers
If Prt.DeviceName = strPrinterName Then
Set Printer = Prt
Exit For
End If
Next Prt

End If

End Sub


Routine requires following declarations:


' WinNT related declarations

Declare Function GetProfileString Lib "kernel32" Alias
"GetProfileStringA" _
(ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long

Declare Function WriteProfileString Lib "kernel32" Alias
"WriteProfileStringA" _
(ByVal lpszSection As String, _
ByVal lpszKeyName As String, _
ByVal lpszString As String) As Long

' OS Version related declaration

Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer


' OS Version related structure

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

' Constant for OSVERSIONINFO.dwPlatformId
Private Const lngVER_PLATFORM_WIN32_WINDOWS As Long
= 1



-----------------------------
Regards,
Shahin