I want to show the last editor's name in the Excel file, because there are some models that can be used by all department members.
Is it possible to get the last editor's name who edited the Excel through Excel VBA?
I think the easiest way to do this is to use this built-in function.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
User = Application.UserName
'Save the user and probably date time in wherever you want
End Sub
You need to insert the code inside 'ThisWorkbook' module:
You may benefit from the built-in property "last author" which gets refreshed with each saving and can be read by the following function:
Private Function LastAuthor() As String
Dim prop As Object
On Error Resume Next
Set prop = ThisWorkbook.BuiltinDocumentProperties("last author")
If Err.Number = 0 Then
LastAuthor = prop.Value
Else
LastAuthor = "Not yet documented!"
End If
End Function
Another built-in property of interest might be "Last save time".
you can create a macros for the event Workbook_Open that writes a current username in some log file. On https://support.microsoft.com they have a sub to get the current username
' Makes sure all variables are dimensioned in each subroutine.
Option Explicit
' Access the GetUserNameA function in advapi32.dll and ' call the function GetUserName.
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
' Main routine to Dimension variables, retrieve user name
' and display answer.
Sub Get_User_Name()
' Dimension variables
Dim lpBuff As String * 25
Dim ret As Long, UserName As String
' Get the user name minus any trailing spaces found in the name.
ret = GetUserName(lpBuff, 25)
UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
' Display the User Name
MsgBox UserName
End Sub
Related
When I call a sub and pass a variable, after the sub ends the passed variable is changed. How do I make it not do that?
So in the example the debug.print should be 3 not 8
sub main()
i = 3
SomeSub i
debug.print i
end sub
sub SomeSub(j)
j=j+5
end sub
Just use the ByVal keyword to pass on the value
Sub SomeSub(ByVal j As Long)
j = j + 5
End Sub
Further reading
Using ByRef and ByVal
When we pass a simple variable to a procedure we can pass using ByRef
or ByVal.
ByRef means we are passing the address of the variable. If the
variable changes in the procedure the original will also be changed.
ByVal means we are creating a copy of the variable. If the variable
changes in the procedure the original will not be changed.
I want to find a way to dynamically add hyperlinks to my Excel-Sheet and run macros depending on some cell contents. But neither the HYPERLINK-formula nor the regular hyperlink feature in Excel allow you to call macros directly from the worksheet. Looking for that problem online will always retrieve the option to use the Worksheet_FollowHyperlink event. But for my purpose this option is not suitable as you either have to write your macro to like "if target.range.address = A1 call macroA elseif target.cell = A2 call macro ...." etc... This solution is way too static in my opinion as you have to "hardwire" too much in your Worksheet_FollowHyperlink code. Furthermore you have to prepare the hyperlinks via VBA to change the address and subaddress to "" to avoid unwanted selection changes or error popups from excel (because some adress could not be found).
The =HYPERLINK()-formula looks way more interesting since you can dynamically create it wherever and whenever needed. It also works fine as a column-function inside a table which is what I actually want to do: Have a column filled with hyperlinks inside a table that will run macros with some given parameters depending on the other contents in each table data row. This would not work with regular hyperlinks at all as the user has to copy & paste them manually into every single row.
Sadly the =HYPERLINK()-formula also offers no option to run a macro directly with the given parameters (at least none that I could find). It will not even fire the Worksheet_FollowHyperlink event so it appears to be a dead end at this point.
Interesting feature I found during my trial and error + internet research:
=HYPERLINK("#TestMe", "Some text here...") will open the VBA-editor and jump directly to my TestMe() sub. Yet it will not be called!
What could be the solution to this problem?
Create Hyperlinks dynamically in a table data column
Call a macro depending on the data row contents
I had the idea to use the Workbook_SheetSelectionChange event to monitor if a cell with a HYPERLINK-formula was selected and it turned out very well.
First revision of my code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim MacroName As String
If Target.Cells.Count > 1 Then Exit Sub
If Target.Formula Like "=HYPERLINK(LEFT(""|""*""|"",*),*)" Then
MacroName = Split(Target.Formula, """|""")(1)
MacroName = VBA.Trim(Replace(MacroName, "&", ""))
MacroName = Sh.Evaluate(MacroName)
Application.Run Macro
End If
End Sub
It requires to have a cell with the following formula:
=HYPERLINK(LEFT("|" & A1 & "|", 0), "Run Macro in A18") where cell A1 contains the name of some macro I want to run. The name of the macro could also be hardwired in the formula.
Note: the LEFT(..., 0) part is needed so the address of the hyperlink will appear empty to excel when clicking it. Otherwise it will bother you with an error popup for not finding the target.
Unfortunately the SelectionChange event also fires when selecting a cell with return-key, tab-key or arrow keys. To filter these out, you will need the following API-call:
Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Boolean
This function checks if a key is pressed at the moment it gets called.
Source is this unresolved question: How to run code when clicking a cell?
The next evolution of the code above now looks like this:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If GetAsyncKeyState(vbKeyTab) _
Or GetAsyncKeyState(vbKeyReturn) _
Or GetAsyncKeyState(vbKeyDown) _
Or GetAsyncKeyState(vbKeyUp) _
Or GetAsyncKeyState(vbKeyLeft) _
Or GetAsyncKeyState(vbKeyRight) _
Or Target.Cells.Count > 1 _
Or VBA.TypeName(Sh) <> "Worksheet" _
Then Exit Sub
Dim Macro As String
If Target.Formula Like "=HYPERLINK(LEFT(""|""*""|"",*),*)" Then
Macro = Split(Target.Formula, """|""")(1)
Macro = VBA.Trim(Replace(Macro, "&", ""))
Macro = Sh.Evaluate(Macro)
Application.Run Macro
End If
End Sub
This now will filter out all selection changes done by key commands.
Yet there is one more step to take as I had to notice there seems to be a flaw when changing a cell above or left of my hyperlink and hit return key or tab key. For some reason the GetAsyncKeyState will return false for both keys so my code would continue to run.
So for these situations I had to create a little dirty work around. You will need the Workbook_SheetChange event to set a switch which temporarily disables the Workbook_SheetSelectionChange event.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
RecentSheetChange = True
Application.OnTime VBA.DateAdd("s", 0.1, Now), "ResetRecentSheetChange"
End Sub
'Code inside a new module:
Option Explicit
Option Private Module
Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Boolean
Public RecentSheetChange As Boolean
Private Sub ResetRecentSheetChange()
RecentSheetChange = False
End Sub
The final code in ThisWorkbook now looks like this:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If GetAsyncKeyState(vbKeyTab) _
Or GetAsyncKeyState(vbKeyReturn) _
Or GetAsyncKeyState(vbKeyDown) _
Or GetAsyncKeyState(vbKeyUp) _
Or GetAsyncKeyState(vbKeyLeft) _
Or GetAsyncKeyState(vbKeyRight) _
Or Target.Cells.Count > 1 _
Or VBA.TypeName(Sh) <> "Worksheet" _
Or RecentSheetChange _
Then Exit Sub
Dim Macro As String
If Target.Formula Like "=HYPERLINK(LEFT(""|""*""|"",*),*)" Then
Macro = Split(Target.Formula, """|""")(1)
Macro = VBA.Trim(Replace(Macro, "&", ""))
Macro = Sh.Evaluate(Macro)
Application.Run Macro
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
RecentSheetChange = True
Application.OnTime VBA.DateAdd("s", 0.1, Now), "ResetRecentSheetChange"
End Sub
Adding parameter features to the hyperlink is only a small step from here.
Your thoughts?
I'm coding in VBA using change event to record every time the number is changing on the excel spreadsheet.
The changing numbers should be recorded from the beginning of the list and the list goes on and on.This is what i'm working on.
you may create a new module and add a global variable, for example.
Global Record As String
and on the workbook add sheet change
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Record = "" Then
Record = Sheet1.Range("a1").Value
Else
Record = Record & "," & Sheet1.Range("a1").Value
End If
End Sub
I have a vba code thats Auto_Open. It does some checks then prompts a userform that asks for username and password. I called this userform with userform_name.show.
My issue is how can I return a Boolean to my Auto_Open sub from the userform code.
I linked the code that verifies if the credentials are correct to the "Login" button on the form. this is the code that produces the Boolean. I need to return it to the Auto_Open.
Private Sub loginbutton()
Dim bool As Boolean
Dim lrup
Dim r As Long
Dim pass As String
loginbox.Hide
'are fields empty
Do While True
If unBox.Text = "" Or pwBox.Text = "" Then
MsgBox ("You must enter a Username and Password")
Else
Exit Do
End If
loginbox.Show
Exit Sub
Loop
'find pw reated to username (if existant)
lrup = UserPass.Range("A1").Offset(UserPass.Rows.Count - 1, 0).End(xlUp).Row
If unBox = "b0541476" And pwBox = "theone" Then
bool = True
Else
MsgBox ("Invalid username or password. Please try again.")
loginbox.Show
Exit Sub
End If
For r = 2 To lrup
If unBox = Cells(r, 1) Then
pass = Cells(r, 2).Value
Exit For
End If
Next
If pass = "" Then
MsgBox ("Invalid username or password. Please try again.")
loginbox.Show
Exit Sub
Else
bool = True
End If
End Sub
You can manage to do this without the use of public variables.
There appears to be a difference between show/hide and load/unload.
If you hide a form while it's still loaded it won't be cleared out, so you can reference the state of the controls on the form.
For example I was using a date picker (called DTPicker1) on a form, my code in the module looks something like this:
Dim NewDay As Date
Load FrmDayPicker
FrmDayPicker.Show
NewDay = FrmDayPicker.DTPicker1.Value
Unload FrmDayPicker
Debug.Print NewDay
On your form you can just use Me.Hide insteaded of Unload Me and this should work
Remove Dim bool As Boolean from the userform code area and declare it in the module as shown below
This is how your Code in the module would look like
Public bool As Boolean
Sub Auto_Open()
'
'~~> Rest of the code
'
UserForm1.Show
If bool = True Then
'~~> Do Something
Else
'~~> Do Something
End If
'
'~~> Rest of the code
'
End Sub
How about using a function instead of a sub?
Function loginbutton()
' your code
loginbutton = bool
End Function
Now in your calling code you can test for true/false
if loginbutton() then
'true responce
else
'false responce
end if
Update:
I was to quick to dismiss public variables. While both methods can work, Pub Vars and directly accessing items, sometimes it's not ideal to access an item directly if say it's a list.
I now have modules specifically for calling UserForms which only declar the public variables and call the userform. I can then call these modules from UserForms or Modules and have access to the public variable after the userform is closed.
Eg: Here is a module I use now, very basic, and all my other needs can just call this module/sub.
Public ColSelectorDic As Object
Public Sub Col_Picker_Sub()
Col_Picker_UserForm.Show
End Sub
It's simplest IMO to use Public Variables declared in the Module calling the UserForm. But, this has the caveat if you wanted to call this userform from separate modules, you will get errors regarding duplicate declarations/ambiguous names.
So, if you know it's only going to be called be the one module, Pub Vars all the way. In my case I was using a "Column Picker" userform, which was very simple and I wanted to be able to utilize it again in unforseen future projects so I attempted to resolve the above caveat.
See this answer for Public Variables, no need to repeat information --> https://stackoverflow.com/a/18966341/5079799
And this answer related to Accessing the Form Variables directly -->
https://stackoverflow.com/a/47919465/5079799 but I felt it could use some expanding.
Also, here is a good article which goes deeper in depth about accessing userform variables directly --> https://gregmaxey.com/word_tip_pages/userform_pass_data.html
So my UserForm looks like this and is named ColPicker:
Private Sub UserForm_Initialize()
Dim i As Long
lCol = Get_lCol(ActiveSheet)
For i = 1 To lCol
ColumnLetter = Col_Letter(i)
Me.ComboBox1.AddItem ColumnLetter
Next
End Sub
Private Sub CommandButton1_Click()
Me.Hide
End Sub
Sub PassVarFromUserForm()
ColPicker.Show
Dim ColLetter As String
ColLetter = ColPicker.ComboBox1.Value
Unload ColPicker
Debug.Print ColLetter
End Sub
Notice how the "Run"/Command Button in the UserForm just hides the form, I then store the values in a variable, THEN unload the form, from the module, via utilizing it's name. (You can only use unload me from within the userform).
The variable is then available inside module and can be declared in the beginning as public, or inside module, it doesn't matter as it can be declared differently in each module, the userform has no idea/reference to what the variable name the information will be stored in.
Does anyone know the VBA Code that I need to use so that I can automatically “Refresh” and “Refresh All” using EPM (Hyperion) Smartiew? The “Refresh” function pulls the data into Excel on the active tab where the “Refresh” all function refreshes all tabs in the Workbook.
I’d like to create a simple macro attached to a command button in Excel and I’m not sure which VBA code to use.
I tried recording a macro where by I simply starting recording clicked refresh and stop recording although this did not work.
I tried this code just for the refresh:
Declare Function HypMenuVRefresh Lib "HsAddin.dll"() As Long
Sub MRetrieve()
X = HypMenuVRefresh()
End Sub
But received an error message saying that I had to update the declare method for use with a 64 bit system (I am using a 64 bit system).
Does anyone know how I could create this automatic Macro to refresh the data?
Any help would be much appreciated!
The declaration for x64 in VBA is not correct.
Try:
Private Declare PtrSafe Function HypMenuVRefresh Lib "HsAddin" () As Long
Sub refreshWS()
Dim Count, i As Integer
i = 1
Count = Worksheets.Count
Do While i <= Count
Sheets(i).Select
MsgBox Sheets(i).Name
Call HypMenuVRefresh
i = i + 1
Loop
MsgBox "done"
End Sub
Use the function calls that basically simulate pressing the buttons!
Refresh current worksheet
Declare Function HypMenuVRefresh Lib "HsAddin.dll" () As Long
lngReturn = HypMenuVRefresh()
Refresh All Worksheets
Declare Function HypMenuVRefreshAll Lib "HsAddin.dll" () As Long
lngReturn = HypMenuVRefreshAll()
*NOTE : Return value of 0 is 'OK'
HypRetrieveRange can refresh or update a range of information, there are also a number of other functions that might suit what you want depending on how much information you need to refresh. Did you import the entire smartview.bas file like they recommended?
Sub Refresh()
'
' Refresh Macro
' Macro recorded 8/12/2011 by joao-oliveira
'
Dim oBar As CommandBar
Set oBar = Application.CommandBars("Worksheet Menu Bar")
oBar.Controls("Hyperion").Controls("Refresh").Execute
End Sub
This worked for me. You'll be able to assign this macro to any button. Instead of using the refresh all function, I am using the HypMenuVRefresh function within each worksheet.
Sub refreshWS()
Dim Count, i As Integer
i = 1
Count = Worksheets.Count
Do While i < Count
Sheets(i).Select
Call HypMenuVRefresh
i = i + 1
Loop
MsgBox "done"
End Sub
Create a button and assign it a new subroutine. Use the call command to call the public function.
Sub RefreshHFM()
'
' RefreshHFM Macro
'
Call HypMenuVRefreshAll
'
End Sub