printing odd even pages

Howdy Dan,

Yes, I think a relatively straght-forward vba procedure is the way to attack this problem. :wink: If you place the following in a normal module and call EvOrOdPrint() you should be able to print even or odd pages in the active worksheet.<pre>
Option Explicit
Private Const MB_YESNOCANCEL = &H3&
Private Const MB_YESNO = &H4&
Private Const MB_RETRYCANCEL = &H5&
Private Const MB_OKCANCEL = &H1&
Private Const MB_OK = &H0&
Private Const MB_ABORTRETRYIGNORE = &H2&
Private Const MB_ICONEXCLAMATION = &H30&
Private Const MB_ICONQUESTION = &H20&
Private Const MB_ICONASTERISK = &H40&
Private Const MB_ICONINFORMATION = MB_ICONASTERISK
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
Private Const IDPROMPT = &HFFFF&
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
Private MSGHOOK As MSGBOX_HOOK_PARAMS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function MessageBox Lib "user32" Alias _
"MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, _
ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function SetDlgItemText Lib "user32" Alias _
"SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, _
ByVal lpString As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias _
"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias _
"SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Dim mbFlags As VbMsgBoxStyle
Dim mbFlags2 As VbMsgBoxStyle
Dim mTitle As String
Dim mPrompt As String
Dim But1 As String
Dim But2 As String
Dim But3 As String

Public Function MessageBoxH(hwndThreadOwner As Long, _
hwndOwner As Long, mbFlags As VbMsgBoxStyle) As Long
'This function calls the hook
Dim hInstance As Long
Dim hThreadId As Long
hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
With MSGHOOK
.hwndOwner = hwndOwner
.hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, _
hInstance, hThreadId)
End With
MessageBoxH = MessageBox(hwndOwner, Space$(120), Space$(120), mbFlags)
End Function

Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'This function catches the messagebox before it opens
'and changes the text of the buttons - then removes the hook
If uMsg = HCBT_ACTIVATE Then
SetWindowText wParam, mTitle
SetDlgItemText wParam, IDPROMPT, mPrompt
Select Case mbFlags
Case vbAbortRetryIgnore
SetDlgItemText wParam, IDABORT, But1
SetDlgItemText wParam, IDRETRY, But2
SetDlgItemText wParam, IDIGNORE, But3
Case vbYesNoCancel
SetDlgItemText wParam, IDYES, But1
SetDlgItemText wParam, IDNO, But2
SetDlgItemText wParam, IDCANCEL, But3
Case vbOKOnly
SetDlgItemText wParam, IDOK, But1
Case vbRetryCancel
SetDlgItemText wParam, IDRETRY, But1
SetDlgItemText wParam, IDCANCEL, But2
Case vbYesNo
SetDlgItemText wParam, IDYES, But1
SetDlgItemText wParam, IDNO, But2
Case vbOKCancel
SetDlgItemText wParam, IDOK, But1
SetDlgItemText wParam, IDCANCEL, But2
End Select
UnhookWindowsHookEx MSGHOOK.hHook
End If
MsgBoxHookProc = False
End Function

Public Function BBmsgbox(mhwnd As Long, _
mMsgbox As VbMsgBoxStyle, Title As String, _
Prompt As String, Optional mMsgIcon As VbMsgBoxStyle, _
Optional ButA As String, Optional ButB As String, _
Optional ButC As String) As String
'This function sets your custom parameters and returns
'which button was pressed as a string
Dim mReturn As Long
mbFlags = mMsgbox
mbFlags2 = mMsgIcon
mTitle = Title
mPrompt = Prompt
But1 = ButA
But2 = ButB
But3 = ButC
mReturn = MessageBoxH(mhwnd, GetDesktopWindow(), _
mbFlags Or mbFlags2)
Select Case mReturn
Case IDABORT
BBmsgbox = But1
Case IDRETRY
BBmsgbox = But2
Case IDIGNORE
BBmsgbox = But3
Case IDYES
BBmsgbox = But1
Case IDNO
BBmsgbox = But2
Case IDCANCEL
BBmsgbox = But3
Case IDOK
BBmsgbox = But1
End Select
End Function

Sub EvOrOdPrint()
Dim mReturn As String, y As Boolean, n As Integer
mReturn = BBmsgbox(1, vbYesNoCancel, _
"Print Pages", "Howdy " & Application.UserName & "." & _
" Shall we print even or odd pages today?", , "Even", "Odd", "Cancel")
If mReturn = "Cancel" Then
Exit Sub
ElseIf mReturn = "Even" Then y = True
Else: y = False
End If
For n = 1 To Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
If (n 2 = n / 2) = y _
Then ActiveSheet.Printout n, n
Next
End Sub</pre><pre></pre>
Kudos to Harold Staff and others regarding the msgbox functionality.

Hope this helps.

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2002-11-06 19:50

Nate this looks like a really cool add on. So I decided to put it into a module in a sheet that is opened every time I open excel. I created a new module (not a Class Module) and I combined the appropriate lines but I am getting an error with the following line.

.hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)

AddressOf get highlighted and the following message is displayed

Compile Error:
Expected:expression

I am running excel 2001 on mac os 9.1. Did I do something stupid in creating the module or what?

Thanks!

I'm not sure if Excel 2001 supporst AddressOf, Excel 97 didn't.

Howdy y'all, I thought this was pretty choice as well...

On 2002-11-07 11:41, Juan Pablo G. wrote:
I'm not sure if Excel 2001 supporst AddressOf, Excel 97 didn't.

Click to expand...

Yes this looks to be true (of '97), AddressOf is supported by a minimum of VBA 6. And not having any clue regarding a Mac, I can't be of too much help here necessarily...

But, all may not be out the window with xl '97.

If you're really interested, have a look @ CallBacks.zip at the following site:

http://www.trigeminal.com/lang/1033/codes.asp?ItemID=19#19

Hone in on the:

Public Function AddrOf(strFuncName As String) As Long

function in the basAddrof module. Suppossedly it will replicate AddressOf functionality in '97.

It may be of use in the Mac as well... Since I have neither a mac nor '97 available at the moment, I'm not able to hack through this with you.

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2002-11-07 15:33

I'll give that a try when I get a chance (probably tomorrow afternoon) and let you know.

Hello folks
Just dragged this from the archives, as it's just what I'm after (No duplex/ odd/even function on printer), but I'm on Excel 97 and this is a bit newer. I've tried to run it but I get a compile error on line

If (n 2 = n / 2) = y _
Then ActiveSheet.Printout n, n

This code is way beyond my meagre capabilities, any suggestions as to if/how I can correct it?

Thanks

Hello guys

Use this corrected working version

Option Explicit

Private Const MB_YESNOCANCEL = &H3&

Private Const MB_YESNO = &H4&

Private Const MB_RETRYCANCEL = &H5&

Private Const MB_OKCANCEL = &H1&

Private Const MB_OK = &H0&

Private Const MB_ABORTRETRYIGNORE = &H2&

Private Const MB_ICONEXCLAMATION = &H30&

Private Const MB_ICONQUESTION = &H20&

Private Const MB_ICONASTERISK = &H40&

Private Const MB_ICONINFORMATION = MB_ICONASTERISK

Private Const IDOK = 1

Private Const IDCANCEL = 2

Private Const IDABORT = 3

Private Const IDRETRY = 4

Private Const IDIGNORE = 5

Private Const IDYES = 6

Private Const IDNO = 7

Private Const IDPROMPT = &HFFFF&

Private Const WH_CBT = 5

Private Const GWL_HINSTANCE = (-6)

Private Const HCBT_ACTIVATE = 5

Private Type MSGBOX_HOOK_PARAMS

hwndOwner As Long

hHook As Long

End Type

Private MSGHOOK As MSGBOX_HOOK_PARAMS

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function MessageBox Lib "user32" Alias _
"MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, _
ByVal lpCaption As String, ByVal wType As Long) As Long

Private Declare Function SetDlgItemText Lib "user32" Alias _
"SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, _
ByVal lpString As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias _
"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function SetWindowText Lib "user32" Alias _
"SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

Dim mbFlags As VbMsgBoxStyle

Dim mbFlags2 As VbMsgBoxStyle

Dim mTitle As String

Dim mPrompt As String

Dim But1 As String

Dim But2 As String

Dim But3 As String



Public Function MessageBoxH(hwndThreadOwner As Long, _
hwndOwner As Long, mbFlags As VbMsgBoxStyle) As Long

'This function calls the hook

Dim hInstance As Long

Dim hThreadId As Long

hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)

hThreadId = GetCurrentThreadId()

With MSGHOOK

.hwndOwner = hwndOwner

.hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, _
hInstance, hThreadId)

End With

MessageBoxH = MessageBox(hwndOwner, Space$(120), Space$(120), mbFlags)

End Function



Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'This function catches the messagebox before it opens

'and changes the text of the buttons - then removes the hook

If uMsg = HCBT_ACTIVATE Then

SetWindowText wParam, mTitle

SetDlgItemText wParam, IDPROMPT, mPrompt

Select Case mbFlags

Case vbAbortRetryIgnore

SetDlgItemText wParam, IDABORT, But1

SetDlgItemText wParam, IDRETRY, But2

SetDlgItemText wParam, IDIGNORE, But3

Case vbYesNoCancel

SetDlgItemText wParam, IDYES, But1

SetDlgItemText wParam, IDNO, But2

SetDlgItemText wParam, IDCANCEL, But3

Case vbOKOnly

SetDlgItemText wParam, IDOK, But1

Case vbRetryCancel

SetDlgItemText wParam, IDRETRY, But1

SetDlgItemText wParam, IDCANCEL, But2

Case vbYesNo

SetDlgItemText wParam, IDYES, But1

SetDlgItemText wParam, IDNO, But2

Case vbOKCancel

SetDlgItemText wParam, IDOK, But1

SetDlgItemText wParam, IDCANCEL, But2

End Select

UnhookWindowsHookEx MSGHOOK.hHook

End If

MsgBoxHookProc = False

End Function



Public Function BBmsgbox(mhwnd As Long, _
mMsgbox As VbMsgBoxStyle, Title As String, _
Prompt As String, Optional mMsgIcon As VbMsgBoxStyle, _
Optional ButA As String, Optional ButB As String, _
Optional ButC As String) As String

'This function sets your custom parameters and returns

'which button was pressed as a string

Dim mReturn As Long

mbFlags = mMsgbox

mbFlags2 = mMsgIcon

mTitle = Title

mPrompt = Prompt

But1 = ButA

But2 = ButB

But3 = ButC

mReturn = MessageBoxH(mhwnd, GetDesktopWindow(), mbFlags Or mbFlags2)

Select Case mReturn

Case IDABORT

BBmsgbox = But1

Case IDRETRY

BBmsgbox = But2

Case IDIGNORE

BBmsgbox = But3

Case IDYES

BBmsgbox = But1

Case IDNO

BBmsgbox = But2

Case IDCANCEL

BBmsgbox = But3

Case IDOK

BBmsgbox = But1

End Select

End Function



Sub EvOrOdPrint()

Dim mReturn As String, y As Boolean, n As Integer

mReturn = BBmsgbox(1, vbYesNoCancel, _
"Print Pages", "Howdy " & Application.UserName & "." & _
" Shall we print even or odd pages today?", , "Even", "Odd", "Cancel")

If mReturn = "Cancel" Then

Exit Sub

ElseIf mReturn = "Even" Then y = True

Else: y = False

End If

For n = 1 To Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")

If (n = (n / 2) * 2) = y Then ActiveSheet.PrintOut n, n

Next

End Sub