Run subprocedure under button - - vba

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.

Related

Event triggered by ANY checkbox click

I'm going crazy trying to find a way for code to run when I click on ANY of the checkboxes on my sheet. I've seen multiple articles talking about making a class module, but I can't seem to get it to work.
I have code that will populate column B to match column C. Whatever I manually type into C10 will populate into B10, even if C10 is a formula: =D9. So, I can type TRUE into D10 and the formula in C10 will result in: TRUE and then the code populates B10 to say: TRUE. Awesome... the trick is to have a checkbox linked to D10. When I click the checkbox, D10 says TRUE and the formula in C10 says TRUE, but that is as far as it goes. The VBA code does not recognize the checkbox click. If I then click on the sheet (selection change), then the code will run, so I know I need a different event.
It is easy enough to change the event to "Checkbox1_Click()", but I want it to work for ANY checkbox I click. I'm not having ANY luck after days of searching and trying different things.
here is the code I'm running so far
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 3 To 11
Range("B" & i).Value = Range("c" & i)
Next i
End Sub
Any help would be appreciated.
this works
' this goes into sheet code
Private Sub Worksheet_Activate()
activateCheckBoxes
End Sub
.
' put all this code in class a module and name the class module "ChkClass"
Option Explicit
Public WithEvents ChkBoxGroup As MSForms.CheckBox
Private Sub ChkBoxGroup_Change()
Debug.Print "ChkBoxGroup_Change"
End Sub
Private Sub ChkBoxGroup_Click()
Debug.Print "ChkBoxGroup_Click"; vbTab;
Debug.Print ChkBoxGroup.Caption; vbTab; ChkBoxGroup.Value
ChkBoxGroup.TopLeftCell.Offset(0, 2) = ChkBoxGroup.Value
End Sub
.
' this code goes into a module
Option Explicit
Dim CheckBoxes() As New ChkClass
Const numChkBoxes = 20
'
Sub doCheckBoxes()
makeCheckBoxes
activateCheckBoxes
End Sub
Sub makeCheckBoxes() ' creates a column of checkBoxes
Dim sht As Worksheet
Set sht = ActiveSheet
Dim i As Integer
For i = 1 To sht.Shapes.Count
' Debug.Print sht.Shapes(1).Properties
sht.Shapes(1).Delete
DoEvents
Next i
Dim xSize As Integer: xSize = 2 ' horizontal size (number of cells)
Dim ySize As Integer: ySize = 1 ' vertical size
Dim t As Range
Set t = sht.Range("b2").Resize(ySize, xSize)
For i = 1 To numChkBoxes
sht.Shapes.AddOLEObject ClassType:="Forms.CheckBox.1", Left:=t.Left, Top:=t.Top, Width:=t.Width - 2, Height:=t.Height
DoEvents
Set t = t.Offset(ySize)
Next i
End Sub
Sub activateCheckBoxes() ' assigns all checkBoxes on worksheet to ChkClass.ChkBoxGroup
Dim sht As Worksheet
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For i = 1 To sht.Shapes.Count
ReDim Preserve CheckBoxes(1 To i)
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
Next i
End Sub
All you need is to let EVERY checkbox's _Click() event know that you want to run the Worksheet_SelectionChange event. To do so you need to add the following line into every _Click() sub:
Call Worksheet_SelectionChange(Range("a1"))
Please note that it is irrelevant what range is passed to the SelectionChange sub since you do not use the Target in your code.

Remove all macros from a visio 2013 file

I have a Viso 2013 .vstm file that launches a VBA macro on document creation (template instanciation when a user opens the template manually). This macro populates the created drawing from a datasource. When finished, I would like to save programatically (from VBA) the drawing that has been generated as a .vsdx file, i.e. with all VBA macros that were used to populate the drawing being removed.
My questions are:
Is it possible to remove all macros programatically from a VBA macro (Visio 2013) which is in the .vstm file itself without causing the VBA Macro to fail and if yes, how can I do it ?
If 1. is not possible, how can I force programatically Visio to save to .vsdx a drawing that has macros (i.e. save ignoring all macros)
If 2. is not possible, how can I copy current drawing (everything except macros) to a new Drawing which should then be savable to .vsdx?
I have tried the following:
Deleting all lines with VBProject.VBComponents.Item(index).CodeModule.DeleteLines causes the macro to fail with "End Function is missing" (I have checked and there is no missing End Function anywhere, my guess is that the macro probably deletes the code that hasn't been executed yet, which in turn causes this error)
Save and SaveEX do not work either, I get a "VBProjects cannot be saved in macro-free files" error/message, even if I add a Application.AlertResponse = IDOK prior to the call to Save / SaveEx.
Here follows a sample code.
Private Sub RemoveVBACode()
' If document is a drawing remove all VBA code
' Works fine however execution fails as all code has been deleted (issue 1)
If ActiveDocument.Type = visTypeDrawing Then
Dim i As Integer
With ActiveDocument.VBProject
For i = .VBComponents.Count To 1 Step -1
.VBComponents.Item(i).CodeModule.DeleteLines 1, .VBComponents.Item(i).CodeModule.CountOfLines
Next i
End With
On Error GoTo 0
End If
End Sub
Private Sub SaveAsVSDX(strDataFilePath As String)
RemoveVBACode
Application.AlertResponse = IDOK
' Next line fails at runtime (issue 2), the same occurs when using Save
ThisDocument.SaveAsEx strDataFilePath, visSaveAsWS + visSaveAsListInMRU
Application.AlertResponse = 0
End Sub
The code that starts the execution of the Macro is the following event:
' This procedure runs when a Visio document is
' created. I.e., when the template (.vstm) is opened.
Private Sub Document_DocumentCreated(ByVal Doc As IVDocument)
' ...
SaveAsVSDX (strDataFilePath)
' ...
End Sub
I finally found a way to achieve what I wanted : generate a macro-less visio drawing, from a macro-enabled drawing.
What IS NOT possible from my understanding :
Have vba code that removes modules / class modules that is launched through an event such as Document_DocumentCreated. The best I could achieve is to remove the content of ThisDocument vba visio object, but all code in modules / class modules were not removable (note that if the macro is called manually, everything works like a charm, but this was not what I wanted to achieve).
Saving a a drawing instanciated from a vstm template as a macro-less vsdx file.
What IS possible (and is my solution to the third part of the question) :
Instead of loading datasource into the drawing instanciated from the vstm file, have the macro do the following:
select all shapes that appear on the page of the drawing that has been instanciated
group them
copy them
create a new Document
setup the page of the new document (orientation, size, disable snapping and gluing)
paste the group into the first page of the newly created document
center the drawing on the new document
Then load the datasource into the newly created document and link data to existing Shapes
Finaly you can save the new document as vsdx
With lots of shapes (more than 400) this takes some time (around 10 seconds), but it works.
Here is the code of the class module that generates the document.
Option Explicit
'Declare private variables accessible only from within this class
Private m_document As Document
Private m_dataSource As DataSourceFile
Private m_longDataRecordsetID As Long
Public Function Document() As Document
Set Document = m_document
End Function
Private Sub CreateDocument()
' I consider here that the active window is displaying the diagram to
' be copied
ActiveWindow.ViewFit = visFitPage
ActiveWindow.SelectAll
Dim activeGroup As Shape
Set activeGroup = ActiveWindow.Selection.Group
activeGroup.Copy
ActiveWindow.DeselectAll
Set m_document = Application.Documents.Add("")
' I need an A4 document
m_document.Pages(1).PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = "297 mm"
m_document.Pages(1).PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = "210 mm"
m_document.Pages(1).PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPageOrientation).FormulaForceU = "2"
m_document.Pages(1).PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPaperKind).FormulaForceU = "9"
m_document.SnapEnabled = False
m_document.GlueEnabled = False
m_document.Pages(1).Paste
m_document.Pages(1).CenterDrawing
End Sub
Private Sub LoadDataSource()
Dim strConnection As String
Dim strCommand As String
Dim vsoDataRecordset As Visio.DataRecordset
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "User ID=Admin;" _
& "Data Source=" + m_dataSource.DataSourcePath + ";" _
& "Mode=Read;" _
& "Extended Properties=""HDR=YES;IMEX=1;MaxScanRows=0;Excel 12.0;"";" _
& "Jet OLEDB:Engine Type=34;"
strCommand = "SELECT * FROM [Data$]"
Set vsoDataRecordset = m_document.DataRecordsets.Add(strConnection, strCommand, 0, "Data")
m_longDataRecordsetID = vsoDataRecordset.ID
End Sub
Private Function CheckDataSourceCompatibility() As Boolean
Dim visRecordsets As Visio.DataRecordsets
Dim varRowData As Variant
Set visRecordsets = m_document.DataRecordsets
varRowData = visRecordsets(1).GetRowData(1)
If varRowData(3) = "0.6" Then
CheckDataSourceCompatibility = True
Else
MsgBox "Using invalid DataSource version, aborting. You shoud use data format version 0.6."
CheckDataSourceCompatibility = False
End If
End Function
Private Sub LinkDataToShapes()
Application.ActiveWindow.SelectAll
Dim ColumnNames(1) As String
Dim FieldTypes(1) As Long
Dim FieldNames(1) As String
Dim IDsofLinkedShapes() As Long
ColumnNames(0) = "ID"
FieldTypes(0) = Visio.VisAutoLinkFieldTypes.visAutoLinkCustPropsLabel
FieldNames(0) = "ID"
Application.ActiveWindow.Selection.AutomaticLink m_longDataRecordsetID, ColumnNames, FieldTypes, FieldNames, 10, IDsofLinkedShapes
Application.ActiveWindow.DeselectAll
End Sub
Public Function GenerateFrom(dataSource As DataSourceFile) As Boolean
Set m_dataSource = dataSource
'Store diagram services
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140
' Create a new document that contains only shapes
CreateDocument
' Load datasource
LoadDataSource
' Check datasource conformity
If CheckDataSourceCompatibility Then
' Link data recordset to Visio shapes
LinkDataToShapes
GenerateFrom = True
Else
GenerateFrom = False
End If
'Restore diagram services
ActiveDocument.DiagramServicesEnabled = DiagramServices
End Function
Hope this helps.

Userform controlled variables within a macro

Morning Guys,
I have ran into a small roadblock with my project. I'm new to VBA and am trying my best to 'learn by doing' but I cannot seem to get my head around macro/userform interactions.
I have a userform with one textbox and 9 checkboxes. This is supposed to show the userform, allow the user to dictate a sheet name, and (from a list of 9 users) select which is active or not (true or false).
In my main sub, I just have a
Allocator.show
command, as you may have guessed, allocator is my userform name.
Then I've sort of just been trying things so I don't know how right the rest of the userform code is;
Private Sub cbGo_Click()
Unload Allocator
End Sub
Private Sub cboxAlison_Click()
If Me.cboxAlison.Value = True Then
AlisonYN = True
Else
AlisonYN = False
End If
End Sub
Private Sub cboxBeverly_Click()
If Me.cboxBeverly.Value = True Then
BevelyYN = True
Else
BevelyYN = False
End If
End Sub
Private Sub cboxCallum_Click()
If Me.cboxCallum.Value = True Then
CallumYN = True
Else
CallumYN = False
End If
End Sub
Private Sub cboxEllen_Click()
If Me.cboxEllen.Value = True Then
EllenYN = True
Else
EllenYN = False
End If
End Sub
Private Sub cboxGeoff_Click()
If Me.cboxGeoff.Value = True Then
GeoffYN = True
Else
GeoffYN = False
End If
End Sub
Private Sub cboxJames_Click()
If Me.cboxJames.Value = True Then
JamesYN = True
Else
JamesYN = False
End If
End Sub
Private Sub cboxLouise_Click()
If Me.cboxLouise.Value = True Then
LouiseYN = True
Else
LouiseYN = False
End If
End Sub
Private Sub cboxMick_Click()
If Me.cboxMick.Value = True Then
MickYN = True
Else
MickYN = False
End If
End Sub
Private Sub cboxTammy_Click()
If Me.cboxTammy.Value = True Then
TammyYN = True
Else
TammyYN = False
End If
End Sub
Private Sub tbRPName_Change()
End Sub
Private Sub UserForm_Initialize()
Dim GeoffYN, TammyYN, CallumYN, JamesYN, MickYN, AlisonYN, BeverlyYN, LouiseYN, EllenYN As Boolean
Dim RP_Name As String
Me.cboxGeoff.Value = True
Me.cboxTammy.Value = True
Me.cboxCallum.Value = True
Me.cboxJames.Value = True
Me.cboxMick.Value = False
Me.cboxAlison.Value = False
Me.cboxBeverly.Value = False
Me.cboxLouise.Value = False
Me.cboxEllen.Value = False
Me.tbRPName = ""
End Sub
All of the named user variables (xxxxYN) are public in my main module.
These are the variables I want to pull back into my main macro as true or false following the user checking the desired boxes, along with the name as a string, and then continue running the original macro.
Any help would be greatly appreciated, I seem to be taking myself round in circles at the moment!
PS if it helps, my userform looks like this;
UserForm
Cheers,
Callum
You wrote "All of the named user variables (xxxxYN) are public in my main module." But we see them declared in userform's Sub UserForm_Initialize, too:
Private Sub UserForm_Initialize()
Dim GeoffYN, TammyYN, CallumYN, JamesYN, MickYN, AlisonYN, BeverlyYN, LouiseYN, EllenYN As Boolean
Dim RP_Name As Stringn
...
even if you declared the same variables as Public in any module, the Userform variables hide their Public namsakes so any Userform setting is not "seen" in other modules
so you'd better remove the Userform dimming statement of the "namesakes" and leave only the Public one
moreover in such a declaration statement as you used, every single variable not explicitly associated with a specific type is implicitly associated to a Variant type
so in the main module you should use a "dimming" statement like follows:
Public GeoffYN As Boolean, TammyYN As Boolean, CallumYN As Boolean, JamesYN As Boolean, MickYN As Boolean, AlisonYN As Boolean, BeverlyYN As Boolean, LouiseYN As Boolean, EllenYN As Boolean
But should all what above get you going, nevertheless I'd recommend you to switch to a "class" approach together with the use of Dictionary object, like follows
in the Allocator code pane place the following code
Option Explicit
Dim chkBoxes() As ChkBx_Class 'array of type "ChkBx_Class" which you define in a Class Module
Private Sub UserForm_Initialize()
Dim nControls As Integer, i As Integer
Dim namesArray As Variant, cbIniValues As Variant
UFInit = True
namesArray = Array("Geoff", "Tammy", "Callum", "James", "Mick", "Alison", "Beverly", "Louise", "Ellen") '<== set here the names to be associated to every CheckBox
cbIniValues = Array(True, True, True, True, False, False, False, False, False) '<== set here the initial values of checkboxes
nControls = UBound(namesArray) + 1 '<== retrieve the number of CheckBoxes you're going to consider in the Form
ReDim chkBoxes(1 To nControls) As ChkBx_Class 'redim the "ChkBx_Class" array
For i = 1 To nControls
Set chkBoxes(i) = New ChkBx_Class 'initialize a new instance of 'ChkBoxClass' class and store it in the array i-th position
With chkBoxes(i)
Set .ChkBox = Me.Controls("CheckBox" & i) 'assign the correct CheckBox control to its "ChkBox" property
.Name = namesArray(i - 1) ' assign the Name property of the Checkbox
.ChkBox.Value = cbIniValues(i - 1) 'set the checkbox correct initial value
Me.Controls("Label" & i) = .Name ' set the corresponding label caption
dealersDict.Add .Name, .ChkBox.Value ' fill the dictionary initial pair of Dealer-name/checkbox-value
End With
Next i
Me.tbRPName.Text = ""
UFInit = False
End Sub
Private Sub cbGo_Click()
Me.Hide
End Sub
add a "Class Module" to your project
either clicking Insert-> Class Module in the VBA IDE main Ribbon menu
or right-clicking anywhere in the VBA IDE Project Window and selecting Insert -> Class Module in subsequent sub-menus
expand the "Class Module" node in the Project Window
if you don't see the Project Window you can open it by clicking View-> Project Window in the main ribbon menu, or press "Ctrl+R"
select the new Class you added (it should be some "Class1" or the likes) and change its name to "ChkBx_Class" in the Property Window "Name" textbox
if you don't see the Property Window you can open it by clicking View-> Property Window in the main ribbon menu or press "F4"
in the Class Module code pane place the following
Option Explicit
'declare class properties: they will be associated in every instance of this class.
Public WithEvents ChkBox As MSForms.CheckBox ' "ChkBox" is now a property of the class of type CheckBox. it's associated to events
Public Name As String
' events associated to ChkBox class property
Sub ChkBox_Click()
If Not UFInit Then dealersDict.Item(Me.Name) = Me.ChkBox.Value ' set the dictionary pair of Dealer-name/checkbox-value
End Sub
edit your main sub module as follows
Option Explicit
Public dealersDict As New Scripting.Dictionary
Public UFInit As Boolean
Sub main()
myval = "io"
Dim myKey As Variant
Allocator.Show
Unload Allocator
For Each myKey In dealersDict
MsgBox myKey & ": " & dealersDict(myKey)
Next myKey
End Sub
create a reference to Microsoft Scripting Runtime Library to use Dictionaries.
this is done by choosing Tools➜References command in the Visual Basic Editor (VBE) which pops up a dialog box in whose listbox you are to find "Microsoft Scripting Runtime" to put a check mark next and press OK.
run the main sub
whenever you need to retrieve the boolean value associated to a given name you just have to use
myBool = dealersDict(name)
where name can be:
a string literal with the wanted name ("Alison", "Mick" , ..)
a string variable whose value stores the wanted name, so that somewhere in your code you may have typed:
Dim name as string
name = "Mick"
such an approach gives you a lot of flexibility, since you only have to:
set the names and their initial boolean values in those two arrays (namesArray and cbIniValues) in UserForm_Initialize
make sure you have checkboxes named after "CheckBox1", "CheckBox2", and so on as well as have labels named after "label1", "Label2", and so on
make sure that "CheckBoxX" is aligned with "LabelX"
make sure namesArray and cbIniValues have the same items number as labels and checkboxes
IDK what the actual issue is, but I tried to recreate your issue and just decided to show you what I have. See if any of this helps you at all.
All of this code is in the userform code, not at the module level. When I change the check box values, the values are stored (outside of the main sub, which is validated in the "check" sub click event).
To make you code a little shorter, you can directly assign the value of a checkbox to a variable
Dim test as Boolean
test = me.CheckBox1.Value
You can insert this into the code of your go button

Toggle Buttons in Powerpoint

I am trying to insert toggle buttons into several pages on a powerpoint. I've got the buttons to behave the way I want, but now I can't see to do two things:
A. Run the program!!! I've deleted everything and started from scratch, except for my first code (see below) and have nothing else written. What do I need to fix it. When I click on the shape that is connected to YourName() nothing happens.
B. I'd like to set the buttons' values to 0 at the start. Once this runs, do you think my code will do that?
Thanks
Sub YourName()
Dim userName As String
Dim ToggleButton1 As ToggleButton
Dim ToggleButton2 As ToggleButton
Dim ToggleButton3 As ToggleButton
Dim ToggleButton4 As ToggleButton
Dim done As Boolean
done = False
While Not done
userName = InputBox(Prompt:="My name is", Title:="Input Name")
If userName = "" Then
done = False
Else
done = True
End If
Wend
FeedbackAnswered = False
ActivePresentation.Slides(2).ToggleButton("ToggleButton1").Value = 0
ActivePresentation.Slides(2).ToggleButton("ToggleButton2").Value = 0
ActivePresentation.Slides(2).ToggleButton("ToggleButton3").Value = 0
ActivePresentation.Slides(2).ToggleButton("ToggleButton4").Value = 0
ActivePresentation.SlideShowWindow.View.Next
End Sub
Your code won't compile (open the IDE, open the module the code's in, choose Debug | Compile). When you try to run broken code within a slide show (as it seems you're doing) PPT doesn't issue any error messages, it just won't attempt to run the code at all.
This at least compiles; I didn't have time to create a presentation with the correct shapes but hey, had to leave SOME of the fun for you:
Option Explicit
Sub YourName()
Dim userName As String
' Dim these as Object; there's no such thing as ToggleButton
Dim ToggleButton1 As Object
Dim ToggleButton2 As Object
Dim ToggleButton3 As Object
Dim ToggleButton4 As Object
Dim done As Boolean
' You forgot one:
Dim FeedbackAnswered As Boolean
done = False
While Not done
userName = InputBox(Prompt:="My name is", Title:="Input Name")
If userName = "" Then
done = False
' you might want to add an Exit Sub here, otherwise the poor
' user has no way out
Else
done = True
End If
Wend
FeedbackAnswered = False
' Fixed these too:
ActivePresentation.Slides(2).Shapes("ToggleButton1").OLEFormat.Object.Value = 0
ActivePresentation.Slides(2).Shapes("ToggleButton2").OLEFormat.Object.Value = 0
ActivePresentation.Slides(2).Shapes("ToggleButton3").OLEFormat.Object.Value = 0
ActivePresentation.Slides(2).Shapes("ToggleButton4").OLEFormat.Object.Value = 0
ActivePresentation.SlideShowWindow.View.Next
End Sub

Name of textbox depends on where it is located in an ArrayList

I'm using VBA to code an application for an Excel file. Put simply, I need the names of my textboxes to change depending on where a certain variable is in an ArrayList.
I have one textbox to start, when someone pushes a button it should add a textbox after the first one, and do this as many times as one presses the button. So the first box should be named tbx1, the second should be tbx2, the third tbx3, and so on.
Now when they press a different button located next to any of the boxes, it deletes that box and button and all boxes after that one are named one lower to make up for it.
Any ideas how to do this? I'm only assuming ArrayList is the best tactic, please correct me if there is a better way.
Here's an example that you can hopefully modify to your needs. I have a userform named UClassList with one commandbutton, cmdAdd, and one textbox, tbxClass_1.
Private mEventButtons As Collection
Public Property Get ClassMax() As Long
ClassMax = 75
End Property
Private Sub cmdAdd_Click()
Dim i As Long
For i = 2 To Me.ClassMax
'find the first invisible control and make it visible
If Not Me.Controls("tbxClass_" & i).Visible Then
Me.Controls("tbxClass_" & i).Visible = True
Me.Controls("cmdClass_" & i).Visible = True
Exit For 'stop after one
End If
Next i
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim tbx As MSForms.TextBox
Dim cmd As MSForms.CommandButton
Dim clsEventClass As CEventClass
Set mEventButtons = New Collection
'Add as many textboxes and commandbuttons as you need
'or you can do this part at design time
For i = 2 To Me.ClassMax
Set tbx = Me.Controls.Add("Forms.TextBox.1", "tbxClass_" & i, False)
tbx.Top = Me.tbxClass_1.Top + ((i - 1) * 25) 'use the first textbox as the anchor
tbx.Left = Me.tbxClass_1.Left
tbx.Width = Me.tbxClass_1.Width
tbx.Height = Me.tbxClass_1.Height
'Create a delete commandbutton
Set cmd = Me.Controls.Add("Forms.CommandButton.1", "cmdClass_" & i, False)
cmd.Top = tbx.Top
cmd.Left = tbx.Left + tbx.Width + 10
cmd.Width = 20
cmd.Height = tbx.Height
cmd.Caption = "X"
'add delete commandbutton to the event class so they all share
'the same click event code
Set clsEventClass = New CEventClass
Set clsEventClass.cmdEvent = cmd
mEventButtons.Add clsEventClass
Next i
End Sub
I have a custom class named CEventClass.
Public WithEvents cmdEvent As MSForms.CommandButton
Private Sub cmdEvent_Click()
Dim i As Long
Dim lThisIndex As Long
Dim tbxThis As MSForms.TextBox
Dim tbxPrev As MSForms.TextBox
Dim uf As UClassList
Set uf = cmdEvent.Parent
'get the number that was clicked
lThisIndex = Val(Split(cmdEvent.Name, "_")(1))
'loop from the next textbox to the end
For i = lThisIndex + 1 To uf.ClassMax
Set tbxThis = uf.Controls("tbxClass_" & i)
Set tbxPrev = uf.Controls("tbxClass_" & i - 1)
'if it's not visible, clear and hide
'the previous textbox
If Not tbxThis.Visible Then
tbxPrev.Text = vbNullString
tbxPrev.Visible = False
uf.Controls("cmdClass_" & i - 1).Visible = False
Else
'if it's visible, copy it's text to the one above
tbxPrev.Text = tbxThis.Text
End If
Next i
End Sub
Instead of adding and deleting and keeping track of a bunch of textboxes, I create all 75 (or fewer) at launch (or design time). Then I just make then visible or hide them as needed.
You can see the workbook I did this on here http://dailydoseofexcel.com/excel/ControlEventClass.xlsm