Hi everyone,

I wrote a macro which should generate a sheet with comments summary
for current workbook. Everything works great except one thing:
setting Font.Bold=True for a teable header for a first time for
current workbook (second time it works fine) takes 4.75 seconds!!!
Because of this my routine takes 4.8 seconds!!! :(((

1) Can anyone explain why is that?
2) How can I avoid this?

Thanx,
Shahin

I think I've found a kind of answer:

http://groups.google.ru/group/micros...d371d6c1c39890

After changing default printer from network to a local one I've
achieved result 0.7 s. Anyway for a first time setting bold takes 0.6
s, second time - 0.3 s.

Anyway is there any way to increase speed without this printers issue?
Or how can it be avoided programmatically without asking end-user to
use a correct printer?

Thanx,
Shahin

You didn't post the offending code, so it's hard to imagine what can be
done.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
Peltier Technical Services, Inc. - http://PeltierTech.com
_______


"Shahin Musayev" wrote in message
...
I think I've found a kind of answer:

http://groups.google.ru/group/micros...d371d6c1c39890

After changing default printer from network to a local one I've
achieved result 0.7 s. Anyway for a first time setting bold takes 0.6
s, second time - 0.3 s.

Anyway is there any way to increase speed without this printers issue?
Or how can it be avoided programmatically without asking end-user to
use a correct printer?

Thanx,
Shahin

Thanx for your reply, Jon. Here is the code:


With wshRNSheet.Range("A1:F1")

.Font.Bold = True 'this line is
reason for delay

With .Interior
.Color = RGB(166, 202, 240)
.Pattern = xlSolid
End With

.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone

With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

End With 'wshRNSheet.Range("A1:F1")

If the problem is solved by changing printers, I find it difficult to believe
that any changes to your code would improve the speed.

Well, unless your code changed printers...

Shahin Musayev wrote:

I think I've found a kind of answer:

http://groups.google.ru/group/micros...d371d6c1c39890

After changing default printer from network to a local one I've
achieved result 0.7 s. Anyway for a first time setting bold takes 0.6
s, second time - 0.3 s.

Anyway is there any way to increase speed without this printers issue?
Or how can it be avoided programmatically without asking end-user to
use a correct printer?

Thanx,
Shahin

--

Dave Peterson

The code is straightforward. Dave makes a good point about the printer
switch.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
Peltier Technical Services, Inc. - http://PeltierTech.com
_______


"Shahin Musayev" wrote in message
...
Thanx for your reply, Jon. Here is the code:


With wshRNSheet.Range("A1:F1")

.Font.Bold = True 'this line is
reason for delay

With .Interior
.Color = RGB(166, 202, 240)
.Pattern = xlSolid
End With

.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone

With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

End With 'wshRNSheet.Range("A1:F1")

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

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

Hi Norman,

I tried your variant. It works too, but a little bit slower. + You
never know the port which is used (Ne01, Ne04 or any other).

BTW I used Const strDOCUMENT_WRITER As String = "Microsoft Office
Document Image Writer" assuming that this one is present on each
computer
just because both my computers ( win XP RUS + Office 2003 RUS; win XP
ENG + Office 2003 ENG) has it. At the moment i don't know what to use
instead, but it should be something universal.

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