View Full Version : Close Workbook Only if Completed
winxmun
05-26-2014, 12:30 AM
Hi All, I was browsing through the thread to find VBA for stopping Users from closing workbook when the range that I specified is blank. Then i saw this thread (http://www.vbaexpress.com/forum/showthread.php?23232-Solved-Restrict-user-to-close-the-file-if-a-cell-is-blank) and it work perfectly fine for me. However how can i save the file without filling up the blank as i meant to restrict other user and not myself. Thanks in advance!
EirikDaude
05-26-2014, 12:58 AM
I think I modified this code from this kb article on Microsoft's homepages (http://support.microsoft.com/kb/161394).
' Declare for call to mpr.dll.
Declare Function WNetGetUser Lib "mpr.dll" _
Alias "WNetGetUserA" (ByVal lpName As String, _
ByVal lpUserName As String, lpnLength As Long) As Long
Const NoError = 0 'The Function call was successful
Function currentUser() As String
' Buffer size for the return string.
Const lpnLength As Integer = 255
' Get return buffer space.
Dim status As Integer
' For getting user information.
Dim lpName As String
' Assign the buffer size constant to lpUserName.
currentUser = Space$(lpnLength + 1)
' Get the log-on name of the person using product.
status = WNetGetUser(lpName, currentUser, lpnLength)
' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
currentUser = Left$(currentUser, InStr(currentUser, Chr(0)) - 1)
Else
' An error occurred.
MsgBox "Unable to get the name."
End
End If
End Function
Then modify the if-clause at the end of xld's code:
if msg <> "" or currentUser = myUsername then
Bob Phillips
05-26-2014, 01:45 AM
You can do it simply with
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim msg As String
Dim i As Long
With Worksheets("Action item tracker")
For i = 2 To .Cells(.Rows.Count, "F").End(xlUp).Row
If .Cells(i, "F").Value <> "" And .Cells(i, "H").Value = "" Then
msg = msg & "Row #" & i & vbNewLine
End If
Next i
If msg <> "" Or Environ("Username") = "myloginname" Then
MsgBox "Incomplete data" & vbNewLine & vbNewLine & msg
Cancel = True
End If
End With
End Sub
EirikDaude
05-26-2014, 01:51 AM
Hah, it seems someone is better at keeping up with new VBA-functions than I am :) Thanks for showing the easier way, xld!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.