Is there a way in VBA-Excel to find how is named the Immediate window in a localized version of Microsoft Office Excel, not English ?
For example, I use an Italian version of Excel, and here Immediate window is called "Immediata", other, for example Dutch here, called it "Direct"
and so on...
I'm trying to modify a function finded in the page linked above, but I wish to release a version able to work in any localized version of MsO Excel.
Thanks in advance for the answer.
The name of the Immediate Window is available in the Window object with the type vbext_wt_Immediate. This type is only available with the correct imports, but all it says is vbext_wt_Immediate = 5. Instead of creating a reference to this, it can be declared and used like this:
Const VBEXT_WT_IMMEDIATE = 5
Function ImmediateLabel() As String
Dim win As Object
For Each win In Application.VBE.Windows
If win.Type = VBEXT_WT_IMMEDIATE Then
ImmediateLabel = win.Caption
End If
Next
End Function
Sub Test()
Debug.Print ImmediateLabel
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++
'+ Function to find the name of the localized +
'+ version of the Immediate windows. +
'++++++++++++++++++++++++++++++++++++++++++++++
Public Function LocalizedImmediateWin() As String
' String pass to the MsgBox.
Dim strMsg As String
' This Integer'll contain the total number of the VBE Windows.
Dim intNumWin As Integer
' This Integer is used as counter in the For...Next loop.
Dim intLoop As Integer
' Count the number of all the windows (show or hidden) in the VBE.
intNumWin = Application.VBE.Windows.Count
' Loop for all the windows find, starting from 1.
For intLoop = 1 To intNumWin
' If the Type of the Windows we're examine is an Immediate Windows then
If Application.VBE.Windows.Item(intLoop).Type = vbext_wt_Immediate Then
' Build the MsgBox.
strMsg = MsgBox("In this localized version of " & Chr(13) & Chr(10) & "Microsoft Office Excel, " & Chr(13) & Chr(10) & "Immediate windows is called:" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Application.VBE.Windows.Item(intLoop).Caption & "", vbCritical, "Localized Immediate")
' Pass the value as result of the Function.
LocalizedImmediateWin = Application.VBE.Windows.Item(intLoop).Caption
Exit For
End If
' Next windows to examine.
Next intLoop
' End of the function.
End Function
' Simple way to try.
Sub Try()
MsgBox LocalizedImmediateWin
End Sub
Related
I need your help. I found the attached vba code but when I run the code I am getting a very strange 1004 error. Could you please give an explanation or try to fix this error?
Thank you so much all!
' Module to remove all hidden names on active workbook
Sub Remove_Hidden_Names()
' Dimension variables.
Dim xName As Variant
Dim Result As Variant
Dim Vis As Variant
' Loop once for each name in the workbook.
For Each xName In ActiveWorkbook.Names
'If a name is not visible (it is hidden)...
If xName.Visible = True Then
Vis = "Visible"
Else
Vis = "Hidden"
End If
' ...ask whether or not to delete the name.
Result = MsgBox(prompt:="Delete " & Vis & " Name " & _
Chr(10) & xName.Name & "?" & Chr(10) & _
"Which refers to: " & Chr(10) & xName.RefersTo, _
Buttons:=vbYesNo)
' If the result is true, then delete the name.
If Result = vbYes Then xName.Delete
' Loop to the next name.
Next xName
End Sub
These Excel built-in range names appear in the Excel name manager when using SUMIFS,IFERROR, COUNTIFS and other formulas.
There are a lot of ways around this, as suggested in the comments.
You can add either of these:
If Not xName.Name Like "_xlfn*" Then
'Or
If InStr(xName.Name, "_xlfn") = 0 Then
first thing in the loop (don't forget to close it), or something similar.
If you for some reason still want to see it, you can add it to the delete if:
If Result = vbYes And Not xName.Name Like "_xlfn*" Then xName.Delete
I sometimes use the MSForms.DataObject object from the Microsoft Forms 2.0 Object Library in Excel VBA. It is absolutely wonderful for reading / writing text data from / to the clipboard. Recently, I stumbled across this article which shows how to instantiate the object using late binding and found that it works beautifully in VBA. Now, I don't have to worry about adding the reference library each time I port my code to new projects.
That discovery made me wonder if it were possible to use the same object in VBScript. There have been several instances in the past when I wanted to manipulate the clipboard with VBScript but all my research at the time indicated that it wasn't possible (aside from using internet explorer, mshta, clip, etc). To my surprise, the DataObject worked exactly as expected when I tried to read the clibboard. However, it would not put data back into the clipboard and threw an error which makes no sense to me. Below are the details.
Error Number: -2147221008 (800401F0)
Error Description: DataObject:PutInClipboard CoInitialize has not been called.
So, is there a workaround for the error I'm getting or is it simply part of the same VBScript limitation described on MSDN and this answer?
Here is the VBScript code I used for testing on my 64 bit Windows 7 PC:
Option Explicit
Dim DObj
Sub TestClipboard()
Dim ClipData
VerifyArchitecture
If Not InitClipboardObject Then
Terminate "Unable to initialize the clipboard object"
ElseIf Not ClipboardPaste(ClipData) Then
Terminate "Unable to retrieve the clipboard data"
End If
' The message box will have the current clipboard text (if any exist)
MsgBox "The clipboard contains the following text:" & _
vbCrLf & vbCrLf & ClipData
ClipData = "Text we put in the clipboard"
' However, this function will not succeed.
If Not ClipboardCopy(ClipData) Then Terminate "Unable to put data into the clipboard"
End Sub
Function InitClipboardObject()
On Error Resume Next
' If the code is run in VBA, the following reference library
' can be used as an alternative to late binding:
' Microsoft Forms 2.0 Object Library
' Note: The reference library will not show up on the
' list unless a userform has already been added in Excel.
' If not, browse for the FM20.DLL file
Set DObj = GetObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
InitClipboardObject = Err = 0
End Function
' Put data in the clipboard similar to pressing Ctrl + C
Function ClipboardCopy(ByVal Data)
On Error Resume Next
DObj.SetText Data
' This line of code will throw the following error
' Error Number: -2147221008 (800401F0)
' Description: DataObject:PutInClipboard CoInitialize has not been called.
' However, it works perfectly in VBA
DObj.PutInClipboard
ClipboardCopy = Err = 0
End Function
' Retrieve data from the clipboard similar to pressing Ctrl + V
Function ClipboardPaste(ByRef Data)
On Error Resume Next
DObj.GetFromClipboard
Data = DObj.GetText(1)
ClipboardPaste = Err = 0
End Function
' This sub will re-load the script using the 32 bit host
' if it is loaded on the 64 bit version. This is necessary
' since the clipboard object is 32 bit.
Sub VerifyArchitecture()
' The code in this sub is a modified version of Vozzie's answer
' and I do not take credit for the idea:
' https://stackoverflow.com/a/15320768/2734431
Dim Arch, Arg, Args, Cmd, ExeFullName, ExeShortName
Dim Path32, Path64, ProcEnv, q, Reload, ScriptName
Dim WinDir, WShell
q = Chr(34)
Reload = False
ExeFullName = WScript.FullName
ScriptName = WScript.ScriptFullName
ExeShortName = Mid(ExeFullName, InStrRev(ExeFullName, "\") + 1)
Set WShell = CreateObject("WScript.Shell")
Set ProcEnv = WShell.Environment("Process")
WinDir = ProcEnv("windir") & "\"
Path32 = WinDir & "SysWOW64\"
Path64 = WinDir & "System32\"
Arch = ProcEnv("PROCESSOR_ARCHITECTURE")
For Each Arg In WScript.Arguments
Args = " " & q & Arg & q
Next
Cmd = q & Path32 & ExeShortName & q & " " & q & ScriptName & q & Args
If InStr(LCase(ExeFullName), LCase(Path64)) <> 0 And Arch = "AMD64" Then
Reload = True
WShell.Run Cmd
End If
Set WShell = Nothing
Set ProcEnv = Nothing
If Reload Then Terminate ""
End Sub
' This sub is designed to clear any global variables, optionally
' display an error message, and stop the script
Sub Terminate(ByVal ErrMsg)
Dim ErrNbr
Set DObj = Nothing
If ErrMsg <> "" Then
ErrNbr = "Error"
If Err <> 0 Then
ErrNbr = ErrNbr & " " & Err & " (" & Hex(Err) & ")"
ErrMsg = ErrMsg & vbCrLf & vbCrLf
ErrMsg = ErrMsg & "Code Error: " & Err.Description
End If
' &H10 = vbCritical
MsgBox ErrMsg, &H10, ErrNbr
End If
WScript.Quit
End Sub
Is it possible to create Excel VBA macro from a string variable?
Suppose we have FirstMacro:
Sub FirstMacro()
Dim MyString
MyString = "Sub SecondMacro()" & Chr(13) & Chr(10) & "MsgBox " & Chr(34) & "Hello" & Chr(34) & Chr(13) & Chr(10) & "End Sub"
Debug.Print MyString
'Here be code that magicly creates SecondMacro
End Sub
Running the macro, I want to create SecondMacro which is stored in VBA string variable. The second macro can be created either below in the same module or in a new module.
So the second macro from string looks like this:
Sub SecondMacro()
MsgBox "Hello"
End Sub
Sure is possible. It should be noted that you can't add/delete from the module you're running code in.
This will append the code at the end of the module. If you can avoid this though you should, I only use it for adding code to buttons that I've added programatically.
With Workbooks(ThisWorkbook.Name).VBProject.VBComponents("MyModuleHere").CodeModule
.InsertLines .CountOfLines + 1, "Sub... End Sub"
End With
So to add to the "MyModuleHere" code module (assuming you have a module named that), drop this in:
Sub addcode()
Dim subtext As String
subtext = "Sub PrintStuff" & vbCrLf & "msgbox ""Hello World""" & vbCrLf & "End Sub"
With Workbooks(ThisWorkbook.Name).VBProject.VBComponents("MyModuleHere").CodeModule
.InsertLines .CountOfLines + 1, subtext
End With
End Sub
As usual, CPearson adds some really useful insight:
http://www.cpearson.com/excel/vbe.aspx
With regard to removing code, which I think you're hinting at in your comment, I use the below function to find a sub name, and remove it (this assumes that I will know the length of the sub):
Function ClearModule(strShapeName As String)
Dim start As Long
Dim Lines As Long
Dim i As Variant, a As Variant
With Workbooks(ThisWorkbook.Name).VBProject.VBComponents("MyModuleHere").CodeModule
For i = .CountOfLines To 1 Step -1
If Left(.Lines(i, 1), 8 + Len(strShapeName)) = "Sub " & strShapeName & "_Cli" Then
.DeleteLines i, 6
End If
Next
End With
End Function
Here you have more or less all variations which, hopefully, will solve your problem. To test this code copy all of it in a normal code module (by default "Module1") Rename it as "Remin" and write "FirstMacro" in cell A1 of the worksheet you activate, a number in cell A2. Then run the first of the following procedures directly from the VBE window.
Sub SelectMacroToRun()
' 04 Apr 2017
Dim MacroName As String
Dim Arg1 As String
Dim Outcome As Long
With ActiveSheet
MacroName = .Cells(1, 1).Value
Arg1 = .Cells(2, 1).Value
End With
On Error Resume Next
Outcome = Application.Run(ActiveSheet.name & "." & MacroName, Arg1)
If Err Then
MsgBox "The macro """ & MacroName & """ wasn't found", _
vbInformation, "Error message"
Else
If Outcome <> xlNone Then MsgBox "Outcome = " & Outcome
End If
End Sub
Private Function FirstMacro(Optional ByVal Dummy As String) As Long
MsgBox "First Macro"
FirstMacro = xlNone
End Function
Private Function SecondMacro(Arg1 As Long) As Long
MsgBox "Second Macro" & vbCr & _
"Argument is " & Arg1
SecondMacro = Arg1 * 111
End Function
The code will run the FirstMacro, reading the name from the worksheet. Change that name to "SecondMacro" to call the second macro instead. The second macro requires an argument, the first only accepts it and does nothing with it. You don't need to pass any argument, but this code shows how to pass (as many as you want, comma separated) and it also shows how to ignore it - the argument is passed to a dummy variable in the FirstMacro, and the function also returns nothing.
Application.Run "Remin" & MacroName, Arg1
Would just run the macro (it could be a sub). Omit the argument if you don't want to pass an argument. "Remin" is the name of the code sheet where the called macro resides. This name could be extended to include the name of another workbook. However, if the called macro isn't in the same module as the caller it can't be Private.
I'm trying to call a function with a variable name that is generated at run time based upon a combo box value. This is straightforward in most languages but I can't seem to figure it out in Excel VBA, I suspect this is because I don't really understand how the compiler works. I've found several posts that are close but don't quite seem to do the trick. The code below is wrong but should give an idea of what I want.
Thanks
Sub main()
'run formatting macros for each institution on format button click
Dim fn As String
Dim x As Boolean
'create format function name from CB value
fn = "format_" & CBinst.Value
'run function that returns bool
x = Eval(fn)
...
End Sub
CallByName is what you'll need to accomplish the task.
example:
Code in Sheet1
Option Explicit
Public Function Sum(ByVal x As Integer, ByVal y As Integer) As Long
Sum = x + y
End Function
Code is Module1 (bas module)
Option Explicit
Sub testSum()
Dim methodToCall As String
methodToCall = "Sum"
MsgBox CallByName(Sheet1, methodToCall, VbMethod, 1, 2)
End Sub
Running the method testSum calls the method Sum using the name of the method given in a string variable, passing 2 parameters (1 and 2). The return value of the call to function is returned as output of CallByName.
You should write a function that accepts the CB value as a parameter and then uses a select case to call the appropriate formatting function.
Something similar to this
Function SelectFormatting(Name as String) As Boolean
Select Case CBinst.Value
Case "Text1":
SelectFormatting = Text1FormattingFunction()
Case "Text2":
.
.
.
End Select
End Function
The above will work but not with a large number of names
Use Application.Run(MacroName, Parameters)
You have to may sure that there is a macro but it is better than the above as there is no select statement.
With respect to my answer above you might also find this useful to check whether the macro exists
'=================================================================================
'- CHECK IF A MODULE & SUBROUTINE EXISTS
'- VBA constant : vbext_pk_Proc = All procedures other than property procedures.
'- An error is generated if the Module or Sub() does not exist - so we trap them.
'---------------------------------------------------------------------------------
'- VB Editor : Tools/References - add reference TO ......
'- .... "Microsoft Visual Basic For Applications Extensibility"
'----------------------------------------------------------------------------------
'- Brian Baulsom October 2007
'==================================================================================
Sub MacroExists()
Dim MyModule As Object
Dim MyModuleName As String
Dim MySub As String
Dim MyLine As Long
'---------------------------------------------------------------------------
'- test data
MyModuleName = "TestModule"
MySub = "Number2"
'----------------------------------------------------------------------------
On Error Resume Next
'- MODULE
Set MyModule = ActiveWorkbook.VBProject.vbComponents(MyModuleName).CodeModule
If Err.Number <> 0 Then
MsgBox ("Module : " & MyModuleName & vbCr & "does not exist.")
Exit Sub
End If
'-----------------------------------------------------------------------------
'- SUBROUTINE
'- find first line of subroutine (or error)
MyLine = MyModule.ProcStartLine(MySub, vbext_pk_Proc)
If Err.Number <> 0 Then
MsgBox ("Module exists : " & MyModuleName & vbCr _
& "Sub " & MySub & "( ) : does not exist.")
Else
MsgBox ("Module : " & MyModuleName & vbCr _
& "Subroutine : " & MySub & vbCr _
& "Line Number : " & MyLine)
End If
End Sub
'-----------------------------------------------------------------------------------
I found a VBA code online that opens up an internal (shared drive) PDF document page in IE (e.g. goes to page 8 of PDF file). I would like to display text in the cell for a user to click (e.g. "Click here to view").
Problem: The cell currently displays '0' and I have to go to the function bar and hit [Enter] to execute.
Excel Version: 2003
Function call:
=GoToPDFpage("S:\...x_2011.pdf",8)
VBA Code:
Function GoToPDFpage(Fname As String, pg As Integer)
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate Fname & "#page=" & pg
.Visible = True
End With
End Function
:EDIT:
I was able to display text, but it's still not a link like I wanted.
="Click to view" & GoToPDFpage("S:\...x_2011.pdf",8)
Thank you for your help.
If you dont have a high complex workbook/worksheet you could try the following:
Turn the "Click to view" cell into a Hyperlink with following characteristics.
Make it point to itself
The text inside the cell must always be the string Page= plus the number that you what the pdf to open in. Eg.: Page=8
Then go to the workseet module and paste the following code:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If Left(ActiveCell.Value, 4) = "Page" Then
GoToPDFpage Range("A1").Value, Mid(ActiveCell.Value, 6)
'This code asumes that the file address is writen in the cell A1
End If
'
End Sub
'
The above written code will trigger every time you run a hyperlink in the worksheet.
As the hyperlink always point to itself, the "Activecell.Value" will always have the page number that you want to open.
I'm assuming that you can put the file address in the cell A1. You could modify this portion to point to any other cell. (including: The cell to the right of the current hyperlink, etc).
This might not be the best option, but if you only need a quick feature in a couple of cells, it might be enough.
Hope it helps !
EDIT:
To make each HLink reference to itself, you can select all the cells where you have the links and then run this procedure:
Sub RefHLink()
Dim xCell As Range
For Each xCell In Selection
ActiveSheet.Hyperlinks.Add Anchor:=xCell, Address:="", SubAddress:= _
xCell.Address, ScreenTip:="Click Here", TextToDisplay:="Page="
Next xCell
End Sub
how about letting excel write a batch file then running it?
*edit paths to pdf and AcroRd32.exe
Sub batfile()
Dim retVal
filePath = "path\pdf.bat"
pg = 2
Open filePath For Output As #1
Print #1, "Start /Max /w " & Chr(34) & "Current E-book" & Chr(34) & " " & Chr(34) & "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe" & Chr(34) & " /a " & Chr(34) & "page=" & pg & Chr(34) & " " & Chr(34) & "H:\Documents\RPG\Dragonlance\New folder\Sample File.pdf" & Chr(34) & ""
Close #1
retVal = Shell(strFilePath)
End Sub
Try Menu->Data->Data Validation. In the 2nd tab you can write your message.