Adding a username to a print

Glaswegian

Well-known Member
Joined
Oct 14, 2003
Messages
1,487
My second post in 2 days!

I've spent some time looking through the Board for some help on this but without much success:

I can add a time and date as a footer on a print - is it possible to add a username as well?(i.e the person logged on to NT and using the sheet). :confused: I tried various options but none worked. Would it work within VBA? or would the required code be rather excessive?

Many thanks
 
I pasted the code but then received the following 'compile error' : "Only comments may appear after End Sub, End Function or End Property". The first 4 lines after Option Explicit were highlighted.(I'm using XL97 - SR1 on NT4).

I tried pasting it into a new workbook (where there was no other code) but still got the same message.

Am I doing something wrong?
 
Upvote 0

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Glaswegian said:
I pasted the code but then received the following 'compile error' : "Only comments may appear after End Sub, End Function or End Property". The first 4 lines after Option Explicit were highlighted.(I'm using XL97 - SR1 on NT4).

I tried pasting it into a new workbook (where there was no other code) but still got the same message.

Am I doing something wrong?

It sounds like it's been pasted incorrectly, try this (it's the same but the first four lines are on one line)

PS. Did you paste it at the Top of the module? - to be on the safe side, insert an new module and then paste it (Insert>Module)

Code:
Option Explicit

Private Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
Private Const NO_ERROR = 0
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&

Sub user_name()
    Dim strBuf As String, lngUser As Long, strUn As String
    strBuf = Space$(255) '//Clear buffer
    lngUser = WNetGetUser("", strBuf, 255)
    If lngUser = NO_ERROR Then
        strUn = Left(strBuf, InStr(strBuf, vbNullChar) - 1)
    MsgBox ("User name is " & Chr(13) & Chr(13) & strUn)
    Else

    End If

End Sub
 
Upvote 0
Cheers jimboy, that worked. I got a msg box with my username.

Apologies if my pasting technique is not very good.
 
Upvote 0
OK, delete the old before_print code and paste this in at the top of the module;
Code:
Option Explicit

Private Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
Private Const NO_ERROR = 0
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&



Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim strBuf As String, lngUser As Long, strUn As String
    strBuf = Space$(255) '//Clear buffer
    lngUser = WNetGetUser("", strBuf, 255)
    If lngUser = NO_ERROR Then
        strUn = Left(strBuf, InStr(strBuf, vbNullChar) - 1)
    'MsgBox ("User name is " & Chr(13) & Chr(13) & strUn)
    Else
    End If
    
    With ActiveSheet.PageSetup
        .RightFooter = ""
        .RightFooter = strUn
        
    End With
End Sub
 
Upvote 0
Sorry, no joy.

Would it be anything to do with the date and time being added to the footer via the page setup menu?

Here is the code I'm currently using to allow users to print any sheet directly from the Contents sheet:

'determines which sheets can be printed directly from the Contents sheet
'click on the relevant check box and then click the Print button

Private Sub CommandButton1_Click()
If Worksheets("Contents").CheckBox1 = True Then
Worksheets("General Information").Select
ActiveWindow.SelectedSheets.PrintOut copies:=1
Sheets("Contents").Select
Range("A1").Select


There are 32 checkboxes available to users for printing. The code is in the worksheet rather than a module.
 
Upvote 0
It could be. Try insert this macro into you a module;

Code:
Option Explicit

Private Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
Private Const NO_ERROR = 0
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&

Sub add_username_to_footer()
Dim strBuf As String, lngUser As Long, strUn As String
    strBuf = Space$(255) '//Clear buffer
    lngUser = WNetGetUser("", strBuf, 255)
    If lngUser = NO_ERROR Then
        strUn = Left(strBuf, InStr(strBuf, vbNullChar) - 1)
    Else
    End If
    
    With ActiveSheet.PageSetup
        .RightFooter = ""
        .RightFooter = strUn
        
    End With
End Sub

The calling it from the command button (I have added code to reset the right footer);

Code:
Private Sub CommandButton1_Click() 
If Worksheets("Contents").CheckBox1 = True Then 
Worksheets("General Information").Select 

'Call the macro here
add_username_to_footer

ActiveWindow.SelectedSheets.PrintOut copies:=1 
Sheets("Contents").Select 
Range("A1").Select 

'Resets RightFooter
    With ActiveSheet.PageSetup
        .RightFooter = ""
    End With
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top