Is it possible in Excel VBA to change the source code of Module in another Module - vba

I have an Excel .xlam file that adds a button in the ribbon to do the following:
Scan the ActiveSheet for some pre-set parameters
Take my source text (a string value, hard coded directly in a VBA Module) and replace designated areas with the parameters retrieved from step 1
Generate a file containing the calculated text
I save the source text this way because it can be password protected and I don't need to drag another file around everywhere that the .xlam file goes. The source text is saved in a separate module called "Source" that looks something like this (Thanks VBA for not having Heredocs):
'Source Module
Public Function GetSource() As String
Dim s As String
s = ""
s = s & "This is the first line of my source text" & vbCrLf
s = s & "This is a parameter {par1}" & vbCrLf
s = s & "This is another line" & vbCrLf
GetSource = s
End Function
The function works fine. My problem is if I want to update the source text, I now have to manually do that in the .xlam file. What I would like to do is build something like a Sub ImportSource() in another module that will parse some file, rebuild the "Source" Module programatically, then replace that Module with my calculated source code. What I don't know is if/how to replace the source code of a module with some value in a string variable.
It's like metaprogramming at its very worst and philosophically I'm against doing this down to my very core. Practically, however, I would like to know if and how to do it.

I realize now that what you really want to do is store some values in your document in a way that is accessible to your VBA, but that is not readable to a user of the spreadsheet. Following Charles Williams's suggestion to store the value in a named range in a worksheet, and addressing your concern that you don't want the user to have access to the values, you would have to encrypt the string...
The "proper way" to do this is described in this article - but it's quite a bit of work.
A much shorter routine is found here. It just uses simple XOR encryption with a hard coded key - but it should be enough for "most purposes". The key would be "hidden" in your macro, and therefore not accessible to prying eyes (well, not easily).
Now you can use this function, let's call it encrypt(string), to convert your string to a value in the spreadsheet:
range("mySecretCell").value = encrypt("The lazy dog jumped over the fox")
and when you need to use it, you use
Public Function GetSource()
GetSource = decrypt(Range("mySecretCell").value)
End Function
If you use the XOR version (second link), encrypt and decrypt would be the same function...
Does that meet your needs better?

As #brettdj already pointed out with his link to cpearson.com/excel/vbe.aspx , you can programmatically change to code of a VBA module using the VBA Extensibility library! To use it, select the library in the VBA editor Tools->References. Note that you need to also change the options in your Trust center and select: Excel Options->Trust Center->Trust Center Settings->Macro Settings->Trust access to the VBA project object model
Then something like the following code should do the job:
Private mCodeMod As VBIDE.CodeModule
Sub UpdateModule()
Const cStrModuleName As String = "Source"
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = Workbooks("___YourWorkbook__").VBProject
'Delete the module
VBProj.VBComponents.Remove VBProj.VBComponents(cStrModuleName)
'Add module
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = cStrModuleName
Set mCodeMod = VBComp.CodeModule
'Add procedure header and start
InsertLine "Public Function GetSource() As String"
InsertLine "Dim s As String", 1
InsertLine ""
'Add text
InsertText ThisWorkbook.Worksheets("Sourcetext") _
.Range("___YourRange___")
'Finalize procedure
InsertLine "GetSource = s", 1
InsertLine "End Function"
End Sub
Private Sub InsertLine(strLine As String, _
Optional IndentationLevel As Integer = 0)
mCodeMod.InsertLines _
mCodeMod.CountOfLines + 1, _
Space(IndentationLevel * 4) & strLine
End Sub
Private Sub InsertText(rngSource As Range)
Dim rng As Range
Dim strCell As String, strText As String
Dim i As Integer
Const cLineLength = 60
For Each rng In rngSource.Cells
strCell = rng.Value
For i = 0 To Len(strCell) \ cLineLength
strText = Mid(strCell, i * cLineLength, cLineLength)
strText = Replace(strText, """", """""")
InsertLine "s = s & """ & strText & """", 1
Next i
Next rng
End Sub

You can "export" and "import" .bas files programmatically. To do what you are asking, that would have to be the approach. I don't believe it's possible to modify the code in memory. See this article

Related

Turn String Into Hyperlink with Preset Name in Excel with VBA

I have a userform where I will be wanting people to enter a link e.g. bbc.com & I want the program to automatically turn this string into a hyperlink (blue underlined) called "website".
Here's what I have so far.
PublicProperty Get Link() as string
Link=Me.Linkbvalue
.cells(blankrow,1).value=me.link
EDIT: Note, words generic to protect company. Actually the problem is not it starting with local server. In the following the file is in the folder but not the subfolder
Entry="\directory\folders_directory\folder\file"
when running code,
address becomes
\directory/folders_directory\folder\sub_folder"\directory\folders_directory\folder\file"
The following might help.
It will convert column A values to hyperlinks.
Sub GetHyperlink()
For Each xCell In Range("A:A")
If xCell.Value <> "" Then
ActiveSheet.Hyperlinks.Add Anchor:=xCell, Address:="http://www." & Replace(xCell.Formula, "www.", ""), TextToDisplay:="Website"
End If
Next xCell
End Sub
This is something that should work, if you read the the entry variable from the Form:
Sub TestMe()
Dim entry As String
entry = "bbc.com"
Dim httpPrefix As String
httpPrefix = "https://"
If Left(entry, Len(httpPrefix)) <> httpPrefix Then
entry = httpPrefix & entry
End If
With Worksheets(1)
.Hyperlinks.Add Anchor:=.Cells(1, 1), _
Address:=entry, _
TextToDisplay:="website"
End With
End Sub
Some business logic is needed to decide whether to write https:// or http:// or anything similar. You may consider using Trim() to remove possible empty cells from the left and the right.

VBA Excel - run string variable as a line of code

In the aim to allow users from different countries to use my application, I would like to initialize a translation of each object in each existing userform (labels,commandbuttons,msgbox,frames, etc...) at the start of the application.
I'll write all the translation in my Languages sheet:
I've already made a first userform where the user types his login, password and selects his language.
After this step, the main userform called "Menu" will be launched.
I've already tried to type a piece of code (here below) to find the line of code, in a msgbox that I want to run (example : menu.commandbutton1.caption="Envoyer email")
Private Sub UserForm_Initialize()
' Definition of language selected during login
Set langue = Sheets("Languages").Cells.Find("chosen",
lookat:=xlWhole).Offset(-1, 0)
' Initialisation of the texts in the selected language
Dim cel As Range
Dim action As String
For Each cel In Sheets("Languages").Range("d3:d999")
If cel <> "" Then
action = cel & "=" & """" & cel.Offset(0, -2) & """"
MsgBox (action)
End If
Next cel
End Sub
I've already read some topics about this subject but those does not correspond exactly to what i would like to do.
If you have a solution, or a work around, it would be very helpful.
If you simply want different MsgBox, based on a coutry, this is probably the easiest way to achieve it. Imagine your file is like this:
Then something as easy as this would allow you to use different strings, based on the country:
Public Sub TestMe()
Dim country As String
Dim language As Long
country = "Bulgaria" 'or write "England" to see the difference
language = WorksheetFunction.Match(country, Range("A1:B1"), 0)
MsgBox (Cells(2, language))
MsgBox "The capital of " & country & " is " & (Cells(3, language))
End Sub
The idea of the whole trick is simply to pass the correct column, which is done through WorksheetFunction.Match.
Taken from an old CR post I have here, this solution pretty much mimicks .NET .resx resource files, and you can easily see how to extend it to other languages, and if I were to write it today I'd probably use Index+Match lookups instead of that rather inefficient loop - but anyway it works nicely:
Resources standard module
Option Explicit
Public Enum Culture
EN_US = 1033
EN_UK = 2057
EN_CA = 4105
FR_FR = 1036
FR_CA = 3084
End Enum
Private resourceSheet As Worksheet
Public Sub Initialize()
Dim languageCode As String
Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
Case Culture.EN_CA, Culture.EN_UK, Culture.EN_US:
languageCode = "EN"
Case Culture.FR_CA, Culture.FR_FR:
languageCode = "FR"
Case Else:
languageCode = "EN"
End Select
Set resourceSheet = Worksheets("Resources." & languageCode)
End Sub
Public Function GetResourceString(ByVal resourceName As String) As String
Dim resxTable As ListObject
If resourceSheet Is Nothing Then Initialize
Set resxTable = resourceSheet.ListObjects(1)
Dim i As Long
For i = 1 To resxTable.ListRows.Count
Dim lookup As String
lookup = resxTable.Range(i + 1, 1)
If lookup = resourceName Then
GetResourceString = resxTable.Range(i + 1, 2)
Exit Function
End If
Next
End Function
The idea is, similar to .NET .resx files, to have one worksheet per language, named e.g. Resources.EN and Resources.FR.
Each sheet contains a single ListObject / "table", and can (should) be hidden. The columns are basically Key and Value, so your data would look like this on sheet Resources.EN:
Key Value
menu.caption Menu
menu.commandbutton1.caption Send email
menu.commandbutton1.controltiptext Click to send the document
And the Resources.FR sheet would have a similar table, with identical keys and language-specific values.
I'd warmly recommend to use more descriptive names though; e.g. instead of menu.commandbutton1.caption, I'd call it SendMailButtonText, and instead of menu.commandbutton1.controltiptext, I'd call it SendMailButtonTooltip. And if your button is actually named CommandButton1, go ahead and name it SendMailButton - and thank yourself later.
Your code can then "localize" your UI like this:
SendMailButton.Caption = GetResourceString("SendMailButtonText")
The Resources.Initialize procedure takes care of knowing which resource sheet to use, based on Application.LanguageSettings.LanguageID(msoLanguageIDUI) - and falls back to EN, so if a user has an unsupported language, you're still showing something.

Can I get the text of the comments in the VBA code

Lets say I have the following:
Public Sub Information()
'TEST
End Sub
Is there a way to get "TEST" as a result?
Somehow through VBA?
E.g. - In PHP there is a good way to take the comments. Any ideas here?
Edit:
There should be a way, because tools like MZ-Tools are able to provide the comments when they generate the documentation.
You need to parse the code yourself, using the VBA Extensibility library (aka "VBIDE API"). Add a reference to the Microsoft Visual Basic for Applications Extentibility 5.3 type library, and then you can access types such as CodePane and VBComponent:
Sub FindComments()
Dim component As VBComponent
For Each component In Application.VBE.ActiveVBProject.VBComponents
Dim contents As String
contents = component.CodeModule.Lines(1, component.CodeModule.CountOfLines)
'"contents" now contains a string with the entire module's code.
Debug.Print ParseComments(contents) 'todo
Next
End Sub
Once you have a module's contents, you need to implement logic to find comments... and that can be tricky - here's some sample code to play with:
Sub Test()
Dim foo 'this is comment 1
'this _
is _
comment 2
Debug.Print "This 'is not a comment'!"
'..and here's comment 3
REM oh and guess what, a REM instruction is also a comment!
Debug.Print foo : REM can show up at the end of a line, given an instruction separator
End Sub
So you need to iterate the lines, track whether the comment is continuing on the next line / continued from the previous line, skip string literals, etc.
Have fun!
After some tests, I got to this solution:
simply pass the name of the code-module to the function and it will print all comment lines. Inline comments won't work(you have to change the condition)
Function findComments(moduleName As String)
Dim varLines() As String
Dim tmp As Variant
With ThisWorkbook.VBProject.VBComponents(moduleName).CodeModule
'split the lines of code into string array
varLines = Split(.lines(1, .CountOfLines), vbCrLf)
End With
'loop through lines in code
For Each tmp In varLines
'if line starts with '
If Trim(tmp) Like "'*" Then
'print comment line
Debug.Print Trim(tmp)
End If
Next tmp
End Function
You can use Microsoft Visual Basic for Applications Extensibility to examine code at runtime:
'Requires reference to Microsoft Visual Basic for Applications Extensibility
'and trusted access to VBA project object model.
Public Sub Information()
'TEST
End Sub
Public Sub Example()
Dim module As CodeModule
Set module = Application.VBE.ActiveVBProject.VBComponents(Me.CodeName).CodeModule
Dim code As String
code = module.lines(module.ProcStartLine("Information", vbext_pk_Proc), _
module.ProcCountLines("Information", vbext_pk_Proc))
Dim lines() As String
lines = Split(code, vbCrLf)
Dim line As Variant
For Each line In lines
If Left$(Trim$(line), 1) = "'" Then
Debug.Print "Found comment: " & line
End If
Next
End Sub
Note that the above example assumes that it's running in a Worksheet or Workbook code module (hence Me when locating the CodeModule). The best method for locating the correct module will depend on where you want to locate the procedure.
You could try with reading line by line of code in your module. Here is just idea returning first comment for further improvements:
Sub callIt()
Debug.Print GetComment("Module1")
End Sub
Function GetComment(moduleName As String)
Dim i As Integer
With ThisWorkbook.VBProject.VBComponents(moduleName).CodeModule
For i = 1 To .CountOfLines
If Left(Trim(.Lines(i, 1)), 1) = "'" Then
'here we have comments
'return the first one
GetComment = .Lines(i, 1)
Exit Function
End If
Next i
End With
End Function
Important! in Reference window add one to 'Microsoft Visual Basic for Applications Extensibility'.

Filename in variable used for formulas and copying

I am trying to use a wildcard filename as a variable so I can use it to copy and do some formulas. And then I want to flatten all the formulas.
It looks like this:
This first part works (first thing opens wildcard file from a cell formula and second assigns only filename without path to variable Prod - hovering over variable prod gives exactly what it should)
Dim wbProd As Workbook
Windows("SB.xlsm").Activate
Set wbProd = Workbooks.Open(FileNAME:=Sheets("refs").Range("B48").Value)
Dim Prod As String
Windows("SB.xlsm").Activate
Prod = Worksheets("refs").Range("B49").Value
Windows("Weekly.xlsx").Activate
With Workbooks(" & Prod & ").Sheets("Report 1")
.Range("A2:BG10", .Range("A2:BG10").End(xlDown)).Copy Workbooks("WeeklyData X.xlsx").ActiveSheet.Range("A2")
End With
Windows("WeeklyData X.xlsx").Activate
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Report 1")
ws.UsedRange.Value = ws.UsedRange.Value
I am getting an error with this first part of copying: With Workbooks(" & Prod & ").Sheets("Report 1"). When I use this copying method without using filename in a variable it works and also when I use variable filename to do Vlookups it works. I dont know what would be the reason not to work here.
Also if you have better way to flatten all the formulas and preseve formats (coz of dates) it would be great.
Thanks,
A quick fix would be to create a Workbook variable (Dim myWB as Workbook),
Then do Set myWB = Workbooks(Prod). Then just do With myWB.Sheets("Sheet1").
The issue is that Excel needs quotes in the sheet name, and so your book is literally being understood as being titled & Prod &. So, to keep your current idea, you need to just add an additional quote to each quote: With Workbooks("" & Prod & "").Sheets("Report 1").
Personally I recommend setting up a workbook variable, but either works!
Edit:
#drLecter - Very welcome! You'll also run into the "double quotes" issue when trying to set up formulas that have quotes in them. IE The worksheet formula =Vlookup("myText",A1:D1,2,False) would, in VBA, become
Cells(1,1).Formula = "=Vlookup(""myText"",A1:D1,2,False)".
As you can see, if I didn't use double quotes, VBA would stop reading the formula at
Cells(1,1).Formula = "=Vlookup(
Use dir() !
Microsoft Documentation link - dir() function
-Returns a string representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.
just adapt something like this::
Sub LoopThroughFiles()
Dim MyObj As Object, MySource As Object, file As Variant
file = Dir("c:\testfolder\")
While (file <> "")
If InStr(file, "test") > 0 Then
MsgBox "found " & file
Exit Sub
End If
file = Dir
Wend
End Sub

Extract All Named Ranges Into A Class

I have a workbook with a very large amount of named ranges (well over 200). I really need a way to work quickly and easily with all of the named ranges so I can then work with / populate them using VBA.
My solution up until now has been to have code inside a bunch of get properties in my public NamedRanges module, to set the property equal to the named range, like so:
Public Property Get LotNumber49() As range
Set LotNumber49 = Common.GetRange(Strings.LotNumber49)
End Property
Where Strings.LotNumber49 is a property which contains the name of the named range as recorded in the workbook, and Common.GetRange is a method that returns a new instance of the desired range object.
While this solution works well (I can now access an instance of that named range by calling NamedRanges.LotNumber49) It is definitely time consuming and tedious to type up the property in the Strings class and another property in the NamedRanges class.
Is there a better way to accomplish this quick referencing of named ranges that anyone can think of? Perhaps iterating over the collection returned by the Workbook.Names property?
Thank you all, I have this workbook to work on as well as four others, which means a whole lot of named ranges!
Get Named Range by String
Why not a simple procedure like so:
Function GetNR(namedRange as String) as Range
Set GetNR = ActiveWorkbook.Names(namedRange).RefersToRange
End Function
Then simply get the named range like so:
Sub Example()
Debug.Print GetNR("NAME").Value
End Sub
Named Range Suggestion in VBA Project
Alternatively if you want the names to popup in your VBA project you need to redefine the Constants in the Strings class. Try this procedure:
Sub GetAllNames()
Dim res As String, n As Name
For Each n In ActiveWorkbook.Names
If InStr(n.Name, "!") = 0 Then res = res & "Const " & n.Name & "=""" & n.Name & """" & vbNewLine
Next n
Dim fFile As Long
fFile = FreeFile
Open "out.txt" For Output As #fFile
Print #fFile, res
Close #fFile
End Sub
You need to repeat this occasionally when modifying the named ranges:
Run the GetAllNames procedure
Open the out.txt file
Copy the outputs to your Strings class or whatever
Now to get a named range use your Common.GetRange method along with your Strings name or simply use the approach above to generate also the Getter code like so:
Sub GetAllGetters()
Dim res As String, n As Name
For Each n In ActiveWorkbook.Names
If InStr(n.Name, "!") = 0 Then res = res & "Public Property Get " & n.Name & "() As range" & vbNewLine & "Set " & n.Name & " = Common.GetRange(Strings." & n.Name & ")" & vbNewLine & "End Property"
Next n
Dim fFile As Long
fFile = FreeFile
Open "outGetters.txt" For Output As #fFile
Print #fFile, res
Close #fFile
End Sub