This is the beginning of my code:
Private FilesPath As String
Private CostCentersPath As String
Private FinalPath As String
Private CurrentName As String
Private CostCenters As Worksheet
Private Final As Workbook
Private Template As Worksheet
Sub ReadySetGo()
FilesPath = "O:\MAP\04_Operational Finance\Accruals\Accruals_Swiss_booked\2017\Month End\10_2017\Advertising\automation\" 'path change ("automation")
CostCentersPath = FilesPath & "CostCenters.xlsx"
CurrentName = InputBox("Please adjust the final file name:", , "ABGR_2017-10_FINAL.xls.xlsx")
FinalPath = FilesPath & CurrentName
Set CostCenters = Workbooks("CostCenters.xlsx").Worksheets("Cost Center Overview")
Set Final = Workbooks(CurrentName)
Set Template = Workbooks("Template.xlsm").Worksheets("Template")
End Sub
Sub ReadySetGo is used only to assign values to variables and is called from within other subs in the module. But obviously with this method I get input box popping up every time the sub is called.
Is there any other way, apart from Workbook.Open event, of passing variable's CurrentName value to other subs in the module, to avoid multiple InputBoxes?
Thanks,
Bartek
In general, there are plenty of good ways to do what you want, depending on the way your application is settled.
Probably the easiest is simply to write:
If CurrentName <> vbNullString Then
InputBox("Please adjust the final file name:", , "ABGR_2017-10_FINAL.xls.xlsx")
End if
But be careful, because it may break your code somewhere. However, in the best case you will only run it once.
Another way is to save the CurrentName value in a given range and to read it from there every time:
If Len(Range("A1")) = 0 Then
Range("A1") = InputBox("Please ...")
End if
CurrentName = Range("A1")
In general, you can go a few steps further and introduce the Singleton pattern to your code https://en.wikipedia.org/wiki/Singleton_pattern, thus making sure that CurrentName is only assigned once. However, it may be a bit overkill in this case - How to create common/shared instance in vba
Great answer by Vityata , I would declare the CurrentName as public variable however If I had to do it in the same setup then
Static CurrentName As String
Static HasName As Boolean
If Not HasName Then
CurrentName = InputBox("Please adjust the final file name:", , "ABGR_2017-10_FINAL.xls.xlsx")
HasName = True
End If
Related
I've been working on some Excel VBA code with the hope of making it expandable, maintainable and easy to read. Some variables in the code require unique hardcoded ranges while others store common/repeated information. I moved the common/repeat code to a global module to reduce the number of times it needs to be defined with the same information, but I'm concerned it will make it too difficult to track the code or leave the code open to errors later by having public variables. Is this a good way to go about coding this or is there a more efficient/user friendly way to make it OOP?
Snippet below.
Module: mCommon
Option Explicit
Public wrkshtInput As Object
Public rngPartSize As Range
Public rngPart2Size As Range
Sub CommonDefinitions()
Set wrkshtInput = Worksheets("INPUT (BOM)")
Set rngPartSize = Range("C5")
Set rngPartSize2 = Range("C6")
End Sub
Module: mUI
Option Explicit
Sub PartToggle()
'OBJECT REF(S): Sheet2 (INPUT (BOM))
'METHOD REF(S): mCommon.CommonDefinitions
'VARIABLE REF(S): mCommon.wrkshtInput, mCommon.rngPartSize
'COMMON VARIABLE DEFINITIONS:
Call mCommon.CommonDefinitions
'DEFINE VARIABLES:
Set rngBlueACM = Range("H129:H134, H136:H141, H144:H147")
Set rngRedACM = Range("H149:H154, H156:H161, H164:H167")
'PART TOGGLE: ON
If mCommon.wrkshtInput.tglbtnPartToggle.Value = True Then
mCommon.rngPartSize.Value = ""
rngBlueACM.Value = "MANUAL"
rngRedACM.Value = "MANUAL"
End If
'PART TOGGLE: OFF
If mCommon.wrkshtInput.tglbtnPartToggle.Value = False Then
mCommon.rngPartSize.Value = "--"
rngBlueACM.Value = "--"
rngRedACM.Value = "--"
End If
End Sub
Sub Part2Toggle()
'OBJECT REF(S): Sheet2 (INPUT (BOM))
'METHOD REF(S): mCommon.CommonDefinitions
'VARIABLE REF(S): mCommon.wrkshtInput, mCommon.rngPart2Size
'COMMON VARIABLE DEFINITIONS:
Call mCommon.CommonDefinitions
'DEFINE VARIABLES
Set rngWhiteACM = Range("H107:H108")
'PART2 TOGGLE: ON
If mCommon.wrkshtInput.tglbtnPart2Toggle.Value = True Then
mCommon.rngPart2Size.Value = ""
rngWhiteACM.Value = "MANUAL"
End If
'PART2 TOGGLE: OFF
If mCommon.wrkshtInput.tglbtnPart2Toggle.Value = False Then
mCommon.rngPart2Size.Value = "--"
rngWhiteACM.Value = "--"
End If
End Sub
This
Set rngPartSize = Range("C5")
has a flaw in that it doesn't have a worksheet qualifier, so will return a range from whatever happens to be the active sheet.
Your "common" code should also not need to be initialized any time you want to use a part of it - that's a little awkward to have those calls spread over your code.
If you want to be "object-oriented" then a better approach (IMO) is to:
First: Change the codename(s) of your worksheet(s) instead of constantly needing to run things like:
Set wsData = ThisWorkbook.Worksheets("Data")
you can just refer directly to Data, Lists etc in your code.
Next: use the worksheet code modules to define methods which "belong" to those sheets. A good example of this would be an "Inputs" sheet where various parameters are entered. So say you have "Account Number" you can put this in your worksheet module for Inputs:
Const RNG_ACCT_NUM As string = "D10"
Property Get Accountnumber()
Accountnumber = Me.Range(RNG_ACCT_NUM).Value
End Property
Property Let Accountnumber(v)
Me.Range(RNG_ACCT_NUM).Value = v
End Property
Now you can use this in your code:
Dim acct
acct = Inputs.AccountNumber
'or
Inputs.AccountNumber = "AB3456"
instead of
Dim wsInputs As Worksheet, acct
Set wsInputs = ThisWorkbook.Worksheets("Inputs")
acct = wsInputs.Range("D10")
'....
wsInputs.Range("D10") = "AB3456"
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.
The following code allows me to go through the workbook and worksheets that have macros:
For Each VBCmp In ActiveWorkbook.VBProject.VBComponents
Msgbox VBCmp.Name
Msgbox VBcmp.Type
Next VBCmp
As this page shows, for a workbook and a sheet, their type are both 100, ie, vbext_ct_Document. But I still want to distinguish them: I want to know which VBCmp is about a workbook, which one is about a worksheet.
Note that VBCmp.Name can be changed, they are not necessarily always ThisWorkbook or Sheet1, so it is not a reliable information for what I am after.
Does anyone know if there exists a property about that?
Worksheet objects and Workbook objects both have a CodeName property which will match the VBCmp.Name property, so you can compare the two for a match.
Sub Tester()
Dim vbcmp
For Each vbcmp In ActiveWorkbook.VBProject.VBComponents
Debug.Print vbcmp.Name, vbcmp.Type, _
IIf(vbcmp.Name = ActiveWorkbook.CodeName, "Workbook", "")
Next vbcmp
End Sub
This is the Function I'm using to deal with exported code (VBComponent's method) where I add a preffix to the name of the resulting file. I'm working on an application that will rewrite, among other statements, API Declares, from 32 to 64 bits. I'm planning to abandon XL 32 bits definitely. After exportation I know from where did the codes came from, so I'll rewrite them and put back on the Workbook.
Function fnGetDocumentTypePreffix(ByRef oVBComp As VBIDE.VBComponent) As String
'ALeXceL#Gmail.com
Dim strWB_Date1904 As String
Dim strWS_EnableCalculation As String
Dim strChrt_PlotBy As String
Dim strFRM_Cycle As String
On Error Resume Next
strWB_Date1904 = oVBComp.Properties("Date1904")
strWS_EnableCalculation = oVBComp.Properties("EnableCalculation")
strChrt_PlotBy = oVBComp.Properties("PlotBy")
strFRM_Cycle = oVBComp.Properties("Cycle")
If strWB_Date1904 <> "" Then
fnGetDocumentTypePreffix = "WB_"
ElseIf strWS_EnableCalculation <> "" Then
fnGetDocumentTypePreffix = "WS_"
ElseIf strChrt_PlotBy <> "" Then
fnGetDocumentTypePreffix = "CH_"
ElseIf strFRM_Cycle <> "" Then
fnGetDocumentTypePreffix = "FR_"
Else
Stop 'This isn't expected to happen...
End If
End Function
I have this sub/macro that works if I run it as BeforeRightClick. However, I would like to change it so I can actually use my rightclick and put the macro on a button instead.
So I have tried to change the name from BeforeRightClick.
I have tried with both a normal form button and an ActiveX.
All this + some more code is posted under Sheet1 and not modules
Dim tabA As Variant, tabM As Variant
Dim adrA As String, adrM As String
' Set columns (MDS tabel) where data should be copied to (APFtabel)
'Post to
'P1-6 divisions ' Name adress, etc
Const APFtabel = "P1;P2;P3;P4;P5;P6;E9;E10;E13;E14;E23;N9;N10;N11;N12;N20"
'Load data from
Const MDStabel = "N;O;P;Q;R;S;H;Y;Z;AB;W;AF;T;D;AA;V;"
Dim APF As Workbook
' APFilNavn is the name of the AP form
Const APFilNavn = "APForm_macro_pdf - test.xlsm"
' Const APFsti As String = ActiveWorkbook.Path
Const APFarkNavn = "Disposition of new supplier"
' APsti is the path of the folder
Dim sysXls As Object, APFSti As String
Dim ræk As Integer
Private Sub CommandButton1_Click()
APFormRun
End Sub
' Here I changed it from BeforeRightClick
Private Sub APFormRun(ByVal Target As Range, Cancel As Boolean)
Dim cc As Object
If Target.Column = 8 Then
APFSti = ActiveWorkbook.Path & "\"
If Target.Address <> "" Then
For Each cc In Selection.Rows
Cancel = True
ræk = cc.Row
Set sysXls = ActiveWorkbook
åbnAPF
overførData
opretFiler
APF.Save
APF.Close
Set APF = Nothing
Set sysXls = Nothing
Next cc
End If
End If
End Sub
Private Sub overførData()
Dim ix As Integer
tabA = Split(APFtabel, ";")
tabM = Split(MDStabel, ";")
Application.ScreenUpdating = False
For ix = 0 To UBound(tabM) - 1
If Trim(tabM(ix)) <> "" Then
adrM = tabM(ix) & ræk
If tabA(ix) <> "" Then
adrA = tabA(ix)
End If
With APF.ActiveSheet
.Range(adrA).Value = sysXls.Sheets(1).Range(adrM).Value
End With
End If
Next ix
End Sub
Private Sub opretFiler()
' Here I run some other macro exporting the files to Excel and PDF
btnExcel
btnExportPDF
End Sub
if you put this code in Sheet1, then to access it from a button you need to define its name (in the button) as Sheet1.APFormRun (and I think you need to make it Public).
If you move the sub and everything it calls to a Module (after doing an Insert->Module), then you do not need the Excel Object Name prefix.
A very detailed write-up about scoping is at the link below. Scroll down to the "Placement of Macros/ Sub procedures in appropriate Modules" section: http://www.globaliconnect.com/excel/index.php?option=com_content&view=article&id=162:excel-vba-calling-sub-procedures-a-functions-placement-in-modules&catid=79&Itemid=475
In your code above, I had to comment out all the subs you didn't include just to get it to compile for debugging.
To make a sub accessible to the Macros button or to "Assign Macro..." you have to make it Public
Also to make a sub accessible, it cannot have any passed parameters.
So you will have to remove the passed parameters from the Public Sub APFormRun() definition
Therefore you will have to re-write the initial portion of APFormRun ... currently your APFormRun relies upon getting a passed parameter (Target) of the selected cell that you right-clicked upon. When you press a button, there is no cell that you are right-clicking upon. It is not a cell-identifying Excel event. You will have to obtain the selected cell via the Selection excel object. There are a lot of StackOverflow answers on how to do that.
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