in my project in vba i have 2 combobox like this:
combobox1=zahedan,zabol
combobox2=621,54130
and 2 arrays which i declare to save list of subitems zahedan and zabol. i use a dictionary to fetch selected array when combobox1 change like this:
Option Explicit
Option Base 1
Dim dicArrays As Scripting.Dictionary
Dim hoze621code
Dim hoze621name
Dim hoze54130code
Dim hoze54130name
when form active program do somethings like below:
Private Sub Worksheet_Activate()
hoze621code = Array(54101, 54102)
hoze621name = array("test1", "test2")
hoze54130code = Array(5421, 5422)
hoze54130name = array("test3", "test4")
Set dicArrays = New Scripting.Dictionary
dicArrays.Add "hoze621name", hoze621name
dicArrays.Add "hoze621code", hoze621code
dicArrays.Add "hoze54130name", hoze54130name
dicArrays.Add "hoze54130code", hoze54130code
now when i use combobox1.change to fetch list of selected area it show me runtimes error 91 or 13? this is combobox1.change code:
Private Sub ComboBox1_Change()
Dim arrayname2(), arraycode2() As String
arrayname2 = dicArrays("hoze" & ComboBox2.List(ComboBox1.ListIndex) & "name")
arraycode2 = dicArrays("hoze" & ComboBox2.List(ComboBox1.ListIndex) & "code")
// do somthings with selected array
End Sub
i think it's ok but not working! any body to help me?
edited: to add some info about variables scoping
not so clear how the code you showed is spread over your project modules
for me to have something that compiled I had to declare as Public thse variables to be shared between UserForm code and module and/or worksheet code, like follows
'code where Private Sub Worksheet_Activate() is placed
Option Explicit
Public hoze621code
Public hoze621name
Public hoze54130code
Public hoze54130name
Public dicArrays As Scripting.Dictionary
next, for sure you have to declare both arrayname2() and arraycode2() variables as of Variant type
Private Sub ComboBox1_Change()
Dim arrayname2() As Variant, arraycode2() As Variant
arrayname2 = dicArrays("hoze" & ComboBox2.List(ComboBox1.ListIndex) & "name")
arraycode2 = dicArrays("hoze" & ComboBox2.List(ComboBox1.ListIndex) & "code")
'do somthings with selected array
' like:
Dim i As Long
MsgBox "arrayname2 has " & UBound(arrayname2) + 1 & " elements"
For i = 0 To UBound(arrayname2)
MsgBox vbTab & "element " & i & ": " & arrayname2(i)
Next i
End Sub
Related
I want to use global variables in my workbook and in the ThisWorkbook code. I declared the following varaibles
Public position_1 as string
Public position_2 as string
If I want to see the value of those variables I believe they need to be fully qualified so
Debug.Print ThisWorkbook.position_1
Debug.Print ThisWorkbook.position_2
I have written a UDF which I will pass in an integer to represent which variable I am looking for. I will only be passing in a single number and not a full variable name. I am trying to find a way to use this integer to concatenate with "position_" to display the value of the global variable, ThisWorkbook.position_1, ThisWorkbook.position_2, etc.
Function Test_Global_Var(position as Integer)
Dim variable_name As String
variable_name = "position_" & position
Debug.Print ThisWorkbook.variable_name
End Function
So when I call
Test_Global_Var(1)
my immediate window should display the value of
ThisWorkbook.position_1
The code below produces the following debug output
2 values defined.
ThisWorkbook.Position(0)
First Value
ThisWorkbook.Position(1)
Second Value
It uses a private array in the workbook named m_position. The contents are accessed by a global property ThisWorkbook.Position(index).
In a module have the following code:
Option Explicit
Public Sub Test()
If ThisWorkbook.NoValues Then
ThisWorkbook.FillValues "First Value", "Second Value"
End If
Debug.Print CStr(ThisWorkbook.Count) & " values defined."
Test_Global_Var 0
Test_Global_Var 1
End Sub
Public Sub Test_Global_Var(ByVal index As Long)
' Part of a UDF
Debug.Print "ThisWorkbook.Position(" & CStr(index) & ")"
Debug.Print ThisWorkbook.Position(index)
End Sub
In ThisWorkbook have the following code:
Option Explicit
Private m_position() As Variant
Private Sub Workbook_Open()
Call DefaultValues
End Sub
Public Property Get Position(ByVal index As Long) As Variant
Position = m_position(index)
End Property
Public Sub DefaultValues()
m_position = Array("First", "Second")
End Sub
Public Sub FillValues(ParamArray args() As Variant)
m_position = args
End Sub
Public Property Get Count() As Long
Count = UBound(m_position) - LBound(m_position) + 1
End Property
Public Property Get NoValues() As Boolean
On Error GoTo ArrUndefined:
Dim n As Long
n = UBound(m_position)
NoValues = False
On Error GoTo 0
Exit Sub
ArrUndefined:
NoValues = True
On Error GoTo 0
End Property
PS. In VBA never use Integer, but instead use Long. Integer is a 16bit type, while Long is the standard 32bit type that all other programming languages consider as an integer.
It is possible to consider a global dictionary variable and pass data through it from the UDF.
First add reference to Microsoft Scripting Runtime:
Thus, build the dictionary like this:
Public myDictionary As Dictionary
To initialize the myDictionary variable, consider adding it to a Workbook_Open event:
Private Sub Workbook_Open()
Set myDictionary = New Dictionary
End Sub
Then the UDF would look like this:
Public Function FillDicitonary(myVal As Long) As String
If myDictionary.Exists(myVal) Then
myDictionary(myVal) = "position " & myVal
Else
myDictionary.Add myVal, "position " & myVal
End If
FillDicitonary = "Filled with " & myVal
End Function
And it would overwrite every key in the dictionary, if it exists. At the end, the values could be printed:
Public Sub PrintDictionary()
Dim myKey As Variant
For Each myKey In myDictionary
Debug.Print myDictionary(myKey)
Next
End Sub
I have this issue with the ComboBox Event Handler.
I managed to create (and fill with items) the Comboboxes I wanted, the code seems to work fine. But after the program has run, if I try to pick one general item inside one of the comboboxes, it seems like the _Change Method is not called --> I cannot handle change events.
Here is my class module (class name: "DB_ComboBox")
Option Explicit
Public WithEvents DB_ComboBoxEvents As MSForms.ComboBox
Private DB_ComboBox_Line As Integer
Private Sub DB_ComboBoxEvents_Change()
MsgBox ("Line : " & DB_ComboBox_Line)
'Here I want handle The comboboxes changes
'But this routine is not called!
End Sub
Sub Box(CBox As MSForms.ComboBox)
Set DB_ComboBoxEvents = CBox
End Sub
Public Property Let Line(value As Integer)
DB_ComboBox_Line = value
End Property
Public Property Get Line() As Integer
Line = DB_ComboBox_Line
End Property
And here is my "Main module", in which I create the comboboxes and pass them to a Collection of "DB_ComboBox"
Sub CreateComboBox(IncCBoxes)
Dim curCombo As MSForms.ComboBox
Dim rng As Range
Dim tot_items As Integer
Dim incAddItem As Integer
Dim incAddItemBis As Integer
Dim itemBaseArray() As String
Dim TEMP_ComboBoxInst As New DB_ComboBox
Set rng = ActiveSheet.Range("J" & IncCBoxes)
Set curCombo = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height).Object
'Add the items
itemBaseArray = Split(Foglio7.Cells(IncCBoxes, DBColFileComboIndexErrori), ";")
For incAddItem = 0 To UBound(itemBaseArray)
Dim itemLastArray() As String
itemLastArray = Split(itemBaseArray(incAddItem), ",")
For incAddItemBis = 0 To UBound(itemLastArray)
curCombo.AddItem (itemLastArray(incAddItemBis))
Next
Next
TEMP_ComboBoxInst.Box curCombo
TEMP_ComboBoxInst.Line = IncCBoxes
customBoxColl.Add TEMP_ComboBoxInst
End Sub
Can anyone please tell me what I'm missing?
Thank you very much
This looks like a timing-issue:
Running this code in another open file will work. In same file it does not.
Seperate the adding to your class from the adding of the OLEControl i.e.:
use Application.ontime now
see code below:
Private customBoxColl As New Collection
Sub CreateComboBox(IncCBoxes As Long)
Dim curCombo As MSForms.ComboBox
Dim rng As Range
Dim tot_items As Integer
Dim incAddItem As Integer
Dim incAddItemBis As Integer
Dim itemBaseArray() As String
Dim itemLastArray() As String
Set rng = ActiveSheet.Range("J" & IncCBoxes)
With ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height)
Set curCombo = .Object
End With
'Add the items
itemBaseArray = Split(Foglio7.Cells(IncCBoxes, DBColFileComboIndexErrori), ";")
For incAddItem = 0 To UBound(itemBaseArray)
itemLastArray = Split(itemBaseArray(incAddItem), ",")
For incAddItemBis = 0 To UBound(itemLastArray)
curCombo.AddItem (itemLastArray(incAddItemBis))
Next
Next
Application.OnTime Now, "'CallToClass """ & curCombo.Name & """,""" & IncCBoxes & "'"
End Sub
Sub CalltoClass(ctl As String, myline As Long)
Dim TEMP_ComboBoxInst As New DB_ComboBox
TEMP_ComboBoxInst.Box ActiveSheet.OLEObjects(ctl).Object
TEMP_ComboBoxInst.line = myline
customBoxColl.Add TEMP_ComboBoxInst
End Sub
I know this doesn't apply to your specific problem, but I'll just post this here for any others who may have this problem. In my case, the events stopped firing because I had just copied my database into a new Github repo.
On reopening Access, the events weren't firing while they had been fine the day before, which completely stumped me, especially since none of the SO answers seemed to address my issue. Basically, Access blocks macros and code, and requires it to be reenabled by clicking OK on the little yellow warning at the top of the screen.
Is there a way to detect when a user
renames, or
deletes a worksheet?
I want to run some code if one of these events happens.
what I have tried
My tool uses a lot of event handlers so one thing I thought of was looping through all the sheetnames during each Worksheet_Change, but I don't think that is the best approach.
This approach goes under the ThisWorkbook module.
Public shArray1 As Variant
Public shArray2 As Variant
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Dim lngCnt As Long
Dim strMsg As String
Dim strSht
Dim vErr
Dim strOut As String
'get all sheet names efficiently in a 1D array
ActiveWorkbook.Names.Add "shtNames", "=RIGHT(GET.WORKBOOK(1),LEN(GET.WORKBOOK(1))-FIND(""]"",GET.WORKBOOK(1)))"
shArray2 = Application.Transpose([INDEX(shtNames,)])
strSht = Application.Transpose(Application.Index(shArray2, , 1))
'exit here if first time code is run
If IsEmpty(shArray1) Then
shArray1 = shArray2
Exit Sub
End If
`check each sheet name still exists as is
For lngCnt = 1 To UBound(shArray1)
vErr = Application.Match(shArray1(lngCnt, 1), strSht, 0)
If IsError(vErr) Then
strOut = strOut & shArray1(lngCnt, 1) & vbNewLine
vErr = Empty
End If
Next
shArray1 = Application.Transpose([INDEX(shtNames,)])
If Len(strOut) > 0 Then MsgBox strOut, vbCritical, "These sheets are gone or renamed"
End Sub
I want a method to inquire, after changing the ActiveSheet, without additional Activating/Deactivating:
The type of Selection in the previous active sheet (of most importance, if it was a ChartObject or Range).
If it is a Range, get the address.
Is this possible ...?
PS: answers to this one will help me getting to the answer of Detect the type of Selection in a Worksheet just deactivated, in any open Workbook. But they are not the same.
You need two separate events to capture the selection, plus a global variable to store the prior object type and name/location.
Worksheet_SelectionChange for a range
A Chart_Select event for the chartobject
For (2) in Excel 2013 there is such an event but for earlier versions we will need a class module
This is accomplished using Jon Peltier's code as a base
There are three code sections below, add them to your workbook with the names and locations as indicated. Then run Set_All_Charts to initialise the charts in the first sheet for the chart class module
Class Module called clsEventChart
Option Explicit
Public WithEvents evtchart As Chart
Private Sub EvtChart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
MsgBox "Changed from : " & TypeName(X) & " " & StrPos & " to" & vbNewLine & "Chart: " & evtchart.Name
StrPos = evtchart.Name
Set X = evtchart
End Sub
normal module
Option Explicit
Public StrPos As String
Public X As Object
Dim clsEventCharts() As New clsEventChart
Sub Set_All_Charts()
Dim ws As Worksheet
Set ws = Sheets(1)
With ws
If .ChartObjects.Count > 0 Then
ReDim clsEventCharts(1 To ws.ChartObjects.Count)
Dim chtObj As ChartObject
Dim chtnum As Integer
chtnum = 1
For Each chtObj In ws.ChartObjects
' Debug.Print chtObj.Name, chtObj.Parent.Name
Set clsEventCharts(chtnum).evtchart = chtObj.Chart
chtnum = chtnum + 1
Next ' chtObj
End If
End With
End Sub
Sheet Event
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox "Changed from " & TypeName(X) & ": " & StrPos & " to: " & vbNewLine & "Range: " & Target.Address
Set X = Selection
StrPos = Target.Address
End Sub
This answer is for part 2 of your question.
Declare oldTarget outside of the SelectionChange event so you can utilize it from other events, such as a change event.
To place in your worksheet code:
Dim oldTarget As Variant
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox ("Address changed from : " & oldTarget & vbNewLine & _
" to: " & Target.Address)
oldTarget = Target.Address
End Sub
Note:
The first selection you make will not have an oldTarget. After that, it will print a Message displaying the old address and new address.
I am trying to create a context menu item to add a row on a sheet at the position of the selected cell and do some more stuff as well. This is done using a custom object of the class clsMyControls to handle all of my custom controls. The controls created, call a macro in a standard module, which forewards the command to the custom object MyControls. MyControls will foreward the command to another object using CallByName.
This way all of my custom Objects can use MyControls to create controls and to route the commands to their own methods.
The routing works fine. I can read the Address of the selected cell, alter the Value etc. However, when I try to insert or delete a row, nothing happens, not even an error.
Below is the code to reproduce the issue. It implements two ways to create the control and to call the Insert Method. The one I have issues with, and the simple way that works.
The second way does not use MyControls and creates its own control. This way it is possible to insert a row.
Both ways call the same Insert method of the same object.
EDIT: [
The difference is the parameters that are passed to the macro. As soon as a Parameter is built into the .onAction-String of the control, the insert method fails. WHY?
]
First, the (simplified) Class clsMyControls which is supposed to handle all my custom controls
Option Explicit
Option Base 1
Private myItems As Collection 'the collection to carry all controls created here
Private myObjects As Collection 'the collection of objects that create controls by means of this object
'____________________________
Private Sub Class_Initialize()
Set myItems = New Collection
Set myObjects = New Collection
End Sub
'____________________________
Public Sub ReturnFromMacro(Optional args As Variant)
Debug.Print "ReturnFromMacro " & Selection.Address
'Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 'It does not work here
CallByName myObjects(args(1)), args(2), VbMethod 'forewarding
End Sub
'____________________________
Public Sub CreateEntry(ObjectReference As Object, ProcedureName As String, Caption As String)
Dim control As Object
With Application.CommandBars("Cell").Controls
Set control = .Add(Type:=msoControlButton, Before:=1, Temporary:=True)
End With
With control
.Caption = Caption
.onAction = ThisWorkbook.name & "!myControlsMacro(" & Chr(34) & "InsertTest" & Chr(34) & "," & Chr(34) & "Insert" & Chr(34) & ")"
.Tag = Application.ThisWorkbook.name & "_clsMyControls"
.beginGroup = True
End With
myItems.Add control, Caption 'storing the newly created Control in a collection
myObjects.Add ObjectReference, ObjectReference.name 'storing the object in a collection to later call it
End Sub
Next, the Class clsInsertTest that uses myControls to create a custom control and owns the Insert method that is called.
In addition it creates an own custom control that bypasses the Object MyControls
Option Explicit
Dim control As Object 'the object to carry the Control that is created in this class
'____________________________
Property Get name() As String
name = "InsertTest"
End Property
'____________________________
Private Sub Class_Initialize()
'asking myControls to create a control, passing Reference THIS object, The method to be called, the name of teh control
MyControls.CreateEntry Me, "Insert", "InsertTest"
createOwnControl 'the simple way
End Sub
'____________________________
Public Sub Insert()
Debug.Print "Insert Called at " & Selection.Address
Selection.Value = "clsInsertTest was here"
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
'____________________________
Private Sub createOwnControl()
With Application.CommandBars("Cell").Controls
Set control = .Add(Type:=msoControlButton, Before:=1, Temporary:=True)
End With
With control
.Caption = "InsertTest2"
.onAction = ThisWorkbook.name & "!InserTest2Macro"
.Tag = Application.ThisWorkbook.name & "_clsMyControls"
.beginGroup = True
End With
End Sub
and last, the module containing initialization, cleanup and the Subs that are called by the custom controls and foreward to the objects
MyControlsMacro is called by the control built by MyControls
InsertTest2Macro is called by the control built by the InserTest Object directly
Option Base 1
Public InsertTest As clsInsertTest 'test object
Public MyControls As clsMyControls 'the Object to handle my controls
'____________________________
Sub CleanUp() 'what it says
Set InsertTest = Nothing
Set MyControls = Nothing
Dim control As Object
For Each control In Application.CommandBars("Cell").Controls
If control.Tag = Application.ThisWorkbook.name & "_clsMyControls" Then
control.Delete
End If
Next control
'Application.CommandBars("Cell").Reset 'just in case...
End Sub
'____________________________
Sub CreateTestObject() 'create my objects (calld at wb open)
Set MyControls = New clsMyControls
Set InsertTest = New clsInsertTest
End Sub
'____________________________
Public Sub myControlsMacro(ParamArray args() As Variant) 'the Sub to foreward the commands to my Controls handler
Dim handover() As String
Dim wert As Variant
Debug.Print "myControlsMacro called at " & Selection.Address
'Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 'does not work
'transforming the ParamArray "args" into an Array of strings to be able to pass it to the next method
For Each wert In args
If Not (Not handover) Then
ReDim Preserve handover(UBound(handover) + 1)
Else
ReDim handover(1)
End If
handover(UBound(handover)) = wert
Next
'calling the object to handle my Controls
MyControls.ReturnFromMacro handover
End Sub
'____________________________
Public Sub InserTest2Macro() ' the simple way
Debug.Print "InserTest2Macro called at " & Selection.Address
CallByName InsertTest, "Insert", VbMethod
End Sub
I have found a solution here:
Excel VBA CommandBar.OnAction with params is difficult / does not perform as expected
The single quotes in the .onAction and removing brackets made it work.
.onAction = ThisWorkbook.name & "!'myControlsMacro " & Chr(34) & "InsertTest" &_
Chr(34) & "," & Chr(34) & "Insert" & Chr(34) & "'"