Hi Shahin,
If your code resolves theproblem, perhaps
you could simplify the routine with something
like:
'===========
Public Sub Tester()
Dim sOldPrinter As String
Const sNewPrinter As String = _
"Microsoft XPS Document Writer on Ne01:" '<<=== CHANGE
sOldPrinter = Application.ActivePrinter
Application.ActivePrinter = sNewPrinter
With wshRNSheet.Range("A1:F1")
.Font.Bold = True 'this line is reason for delay
End With
Application.ActivePrinter = sOldPrinter
End Sub
'<<===========
---
Regards.
Norman
"Shahin Musayev" wrote in message
...
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