Copying cell value to textbox vba - vba

I have been trying to write a macro that will dynamically fill a textbox on a new sheet will the value of a cell from another sheet.
I have managed to get it working using this:
Sub copyDetail()
' Define variables
Dim pre As Worksheet
Dim des As Worksheet
Set pre = Sheets("Presentation")
Set des = Sheets("Description")
Dim i As Integer
Dim lbl As String
' Scroll through labels and copy where boolean = 1
For i = 2 To 17
If des.Cells(i, 2) = 1 Then
lbl = des.Cells(i, 11)
Sheets("Presentation").Select
ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
Selection.Text = lbl
Else
End If
Next i
End Sub
I basically want to be able to do exactly what this does but without using select all the time as this changes sheets and slows down my code (I have many other sub's to run alongside this one). I've tried things like defining the textbox using this:
Dim myLabel As Object
Set myLabel = pre.Shapes.Range(Array("TextBox 1"))
But then I get an "object doesn't support this property or method" error when I try and call:
myLabel.Text = lbl

You can set the text of a TextBox like so:
ActiveSheet.Shapes("TextBox 1").TextFrame.Characters.Text = "Hello world"
You can set-up a little helper Sub in a Module to make the code re-usable:
Public Sub SetTextBoxText(ws As Worksheet, strShapeName As String, strText As String)
Dim shp As Shape
On Error Resume Next
Set shp = ws.Shapes(strShapeName)
If Not shp Is Nothing Then
shp.TextFrame.Characters.Text = strText
Else
Debug.Print "Shape not found"
End If
End Sub

Related

Improve 33 checkbox code subs to few? (Checkbox for auto-date in bookmarks)

:)
Im new to VBA!
I have a working code for inserting date where i have a bookmark when using a checkbox (ActiveX). Problem is i have 33 checkboxes (I actually wish for 33x2. one for yes and one for no). So i ended up with 33 Subs and 33 bookmarks. I bet this code can be more efficient braking it down to just a few subs. Annyone has anny idea if it can be done?
The code under is the first of 33 repeating subs where Sub and bookmark name is agi1, agi2 agi3.....
Private Sub agi1_Click()
Dim rngFormat As Range
Set rngFormat = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks("agi1").Range.Start, _
End:=ActiveDocument.Bookmarks("agi1").Range.End)
With rngFormat
.Font.Size = 8
End With
Dim v
Dim BMRange As Range
v = ThisDocument.agi1.Value
'Sjekke om boks er sjekket eller ikke
If v = True Then
'Sett inn dato i bokmerke
Set BMRange = ActiveDocument.Bookmarks("agi1").Range
With Selection.Font
.Size = 9
End With
BMRange.Text = (Format(Date, "dd.mm.yyyy"))
Else
'Erstatte dato med tom tekst hvis boks ikke er sjekket
Set BMRange = ActiveDocument.Bookmarks("agi1").Range
BMRange.Text = " "
End If
'Sett inn bokmerke på nytt
ActiveDocument.Bookmarks.Add "agi1", BMRange
End Sub
You could use event sinking, maybe to.
In an normal module, create a collection and populate it to hold the classes that will control the check box events.
In this have the code, this will need to be run on opening the document, something early in it's life to populate the collection.
Public col As Collection
Public Sub SETUP()
Dim o As InlineShape
Dim c As MSForms.CheckBox
Dim cust As clsCustomCheckBox
Set col = New Collection
For Each o In ActiveDocument.InlineShapes
Set c = o.OLEFormat.Object
Set cust = New clsCustomCheckBox
cust.INIT c
col.Add cust
Next o
End Sub
and then have a class module called clsCustomCheckBox and have it's code as
Private WithEvents c As MSForms.CheckBox
Public Function INIT(cmdIN As MSForms.CheckBox)
Set c = cmdIN
End Function
Private Sub c_Click()
MsgBox "Here you can get the name " & c.Name
End Sub
This will divert each checkbox click to the classes c_click rather than it's own.
So for you
Dim rngFormat As Range
Set rngFormat = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks(c.name).Range.Start, _
End:=ActiveDocument.Bookmarks(c.name).Range.End)
With rngFormat
.Font.Size = 8
End With
.......
ActiveX controls always register their event handlers like so:
Private Sub NameOfTheControl_NameOfTheEvent({args})
If you rename the handler, the control stops working - because the name of the handler must be formed as above, with an underscore separating the name of the control and the name of the handled event.
So if your controls must exist at compile-time, there's no way around it: for 33 controls you need 33 handlers.
That doesn't mean you need that huge procedure repeated 33 times!
Extract a procedure. Select the entire body of that handler, cut it.
Now make a new procedure prototype:
Private Sub HandleCheckBoxClick(ByVal controlName As String)
End Sub
And paste the body in there. Then replace all the places you have a hard-coded "agi1" with a reference to this controlName parameter:
Dim rngFormat As Range
Set rngFormat = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks(controlName).Range.Start, _
End:=ActiveDocument.Bookmarks(controlName).Range.End)
With rngFormat
.Font.Size = 8
End With
'...
The places where you're referring to the control using its programmatic name will be a bit harder:
v = ThisDocument.agi1.Value
You can get the MSForms.CheckBox control through the ThisDocument.InlineShapes collection, but that won't let you find a checkbox by its name, so you need a function that can do it for you:
Private Function FindCheckBoxByName(ByVal controlName As String) As MSForms.CheckBox
Dim sh As InlineShape
For Each sh In ThisDocument.InlineShapes
If TypeOf sh.OLEFormat.Object Is MSForms.CheckBox Then
If sh.OLEFormat.Object.Name = controlName Then
'return the MSForms control:
Set FindControlByName = sh.OLEFormat.Object
End If
End If
Next
And now you can do this:
Dim cb As MSForms.ChecBox
Set cb = FindCheckBoxByName(controlName)
If cb Is Nothing Then
MsgBox "No ActiveX CheckBox control named '" & controlName & "' was found in ThisDocument."
Exit Sub
End If
v = cb.Value
Once all references to the ActiveX control are parameterized, your 33 handlers can now look like this:
Private Sub agi1_Click()
HandleCheckBoxClick "agi1"
End Sub
Private Sub agi2_Click()
HandleCheckBoxClick "agi2"
End Sub
'...
Private Sub agi33_Click()
HandleCheckBoxClick "agi33"
End Sub
Alternatively, you could have the checkboxes created at run-time, and then have their Click event handled in a dedicated class module, but that's a little bit more involved ;-)

TopLeftCell error with macro to set variables based on the button that is pressed

I'm trying to write a sub that will delete the contents of a row and move the contents of everything below that row up to fill the gap.
I want to apply the same macro to each command button on the spreadsheet, at creation, so I wanted to write the macro such that it gets all its position information from the action of clicking the button that calls the macro.
For some reason, it just started giving me an "Unable to get the TopLeftCell property of the Button class" error (it used to work pretty okay, but somehow I broke it as I was trying to fix it).
What am I doing wrong?
Here is my code
Sub DelTask()
Dim btn As Object 'variable to be used as the button pressed
Dim btnadd As String 'variable for the address of the pressed button
Dim tsk As Range 'Variable for the location of the task name
Dim tskadd As String
Dim btnRow As Integer 'variable to hold the row of the button pressed
Dim delcell As Range
Dim shftcell As Range
Dim shftcells As String
NumTasks = Application.WorksheetFunction.CountA(Sheets("Tasks").Range("B7:B10000"))
Set btn = ActiveSheet.Buttons(Application.Caller)
With btn.TopLeftCell
btnadd = .Address
btnRow = .Row
End With
Set tsk = Sheets("Tasks").Range(btnadd).Offset(0, -11)
tskadd = Sheets("Tasks").Range(btnadd).Offset(0, -11).Address
Here is the code from the macro that creates the buttons in the first place:
Dim CaseyCell As Range 'Range Variable
Dim CellAdd As String 'variable to hold address of cell
Dim CaseyDel As Range 'Range variable for delete checkbox
Dim CellDel As String 'variable to hold address of delete checkbox
Dim btn As String
Set CaseyCell = Sheets("Tasks").Range("ToDo_Start").Offset(NumTasks + 1, 10)
Set CaseyDel = Sheets("Tasks").Range("ToDo_Start").Offset(NumTasks + 1, 11)
'CaseyCell.Select
CellAdd = CaseyCell.Address(False, False)
CellDel = CaseyDel.Address(False, False)
If New_Edit = "New" Then
With ActiveSheet.CheckBoxes.Add(CaseyCell.Left, CaseyCell.Top, CaseyCell.Width, CaseyCell.Height)
' .name = "Chkbx" & CellAdd
.Caption = ""
.LinkedCell = CellAdd
.Placement = xlFreeFloating
.OnAction = "CrossOutRow"
End With
With ActiveSheet.Buttons.Add(CaseyDel.Left, CaseyDel.Top, CaseyDel.Width, CaseyDel.Height)
.Name = "Button" & CellDel
.Caption = "DELETE TASK"
.Characters.Font.Name = "Calibri"
.Characters.Font.Size = 12
.Characters.Font.StrikeThrough = False
.Characters.Font.Superscript = False
.Characters.Font.Subscript = False
.Characters.Font.Shadow = False
.Characters.Font.Underline = xlUnderlineStyleNone
.Characters.Font.ColorIndex = xlAutomatic
.OnAction = "DelTask"
End With
End If
You need to set btnadd
NumTasks = Application.WorksheetFunction.CountA(Sheets("Tasks").Range("B7:B10000"))
Set btn = ActiveSheet.Buttons(Application.Caller)
Set btnadd = btn.topleftcell
btnRow = btn.topleftcell.Row
Set tsk = Sheets("Tasks").Range(btnadd).Offset(0, -11)
tskadd = Sheets("Tasks").Range(btnadd).Offset(0, -11).Address
You'll have the same issue with tsadd if you used it the same way I think.
Topleftcell returns a range object, you dont need to get its address to use it in range(name).
My error was in naming the command buttons with their destination cells. Each time a command box was created after any cells had been shifted, it would have a duplicate name, and the .TopLeftCell property wouldn't work.
I don't exactly know why, but removing the .name = "Button" & CellDel line from my code seemed to fix it.
Thanks for the suggestions!

Catia VBA Automation Error Run-Time 80010005 - Selection ERROR

I have a Problem with my Userform. It should automatically Switch to another TextBox when an selection in the catpart made. I get the Automation Error: It is illegal to call out while inside message filter.
Run-time error '-2147418107 (80010005)
Sub Auswahl_Click()
Dim sel As Object, Objekt As Object, ObjektTyp(0)
Dim b, Auswahl, i As Integer
ObjektTyp(0) = "Body"
Set sel = CATIA.ActiveDocument.Selection
For i = 1 To 6
sel.Clear
UserFormNow.Controls("Textbox" & i).SetFocus
Auswahl = sel.SelectElement2(ObjektTyp, "Wähle ein Body aus...", False)
Set b = CATIA.ActiveDocument.Selection.Item(i)
If Auswahl = "Normal" Then
Set Objekt = sel.Item(i)
UserFormNow.ActiveControl = Objekt.Value.Name
sel.Clear
End If
i = i + 1
Next
sel.Clear
End Sub
' EXCEL DATEI ÖFFNEN____________________________________
Sub Durchsuchen1_Click()
Dim FPath As String
FPath = CATIA.FileSelectionBox("Select the Excel file you wish to put the value in", "*.xlsx", CatFileSelectionModeOpen)
If FPath = "" Then
Else
DurchsuchenFeld.AddItem FPath
ListBox1.Clear
ListBox1.AddItem "Bitte wählen Sie das Panel"
TextBox1.SetFocus
End If
End Sub
' FORMULAR SCHLIEßEN____________________________________
Sub ButtonEnd_Click()
ButtonEnd = True
Unload UserFormNow
End Sub
First you have to know that when you use an UI and still want to interact with CATIA, you have to choices:
Launch the UI in NoModal: mode UserFormNow.Show 0
Hide the UI each time you want to interact with CATIA: Me.Hide or UserFormNow.Hide
Then, I strongly recommend you to avoid looking for items with names:
UserFormNow.Controls("Textbox" & i).SetFocus
If you want to group controls and loop through them, use a Frame and then use a For Each loop.
For Each currentTextBox In MyFrame.Controls
MsgBox currentTextBox.Text
Next
Regarding your code, many simplifications can be done:
Private Sub Auswahl_Click()
Dim sel As Object
Dim currentTextBox As TextBox
Dim Filter As Variant
ReDim Filter(0)
Filter(0) = "Body"
Set sel = CATIA.ActiveDocument.Selection
'Loop through each textbox
For Each currentTextBox In MyFrame.Controls
sel.Clear
'Ask for the selection and test the result at the same time
If sel.SelectElement2(Filter, "Wahle ein Body aus...", False) = "Normal" Then
'Get the name without saving the object
currentTextBox.Text = sel.Item2(1).Value.Name
Else
'allow the user to exit all the process if press Escape
Exit Sub
End If
Next
sel.Clear
End Sub

Call Userform based on Userform Value in cell

I have a table with the following values:
Now, I would like to call the Userform in column H based on the value in column G, but I can't work out how to call the Userform based on the cell value. The error occurs in line
form.Name = wsControls.Cells(loop2, 8).Value
Here is my code:
Sub Check_Scenarios()
Dim wsAbsatz As Worksheet
Dim wsControls As Worksheet
Dim wsData As Worksheet
Dim loop1 As Long
Dim loop2 As Long
Dim lngKW As Long
Dim form As UserForm
Set wsAbsatz = ThisWorkbook.Worksheets("Production")
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsControls = ThisWorkbook.Worksheets("Controls")
lngKW = wsControls.Cells(1, 2).Value + 2
If lngKW = 3 Then
Exit Sub
End If
For loop1 = wsControls.Cells(10, 2).Value To wsControls.Cells(19, 2).Value Step 10
If wsData.Cells(loop1 + 3, lngKW).Value <> "" Then
MsgBox (wsData.Cells(loop1 + 3, lngKW).Value)
For loop2 = 2 To 16
If wsData.Cells(loop1 + 3, lngKW).Value = wsControls.Cells(loop2, 7).Value Then
form.Name = wsControls.Cells(loop2, 8).Value 'error occurs here
form.Show
End If
Next loop2
End If
Next loop1
End Sub
Project:
Many thanks for your help!
You are trying to assign a Name to a blueprint. These are two errors.
You have to initialize your blueprint as something. Like this:
Dim form As New UserForm
Then, most probably your UserForm does not have a property called Name. It is called Caption. Thus it is like this:
Sub TestMe()
Dim uf As New UserForm1 'judging from your screenshot
uf.Caption = "Testing"
uf.Show
End Sub
Disclaimer:
There is a better way to work with UserForms, not abusing the blueprint, although almost every VBA book shows this UserForm.Show method (in fact every single one I have read so far).
If you have the time and the OOP knowledge implement the ideas from here - or from my interpretation of the ideas. There was also a documentation article about it in StackOverflow, but it was deleted with the whole documentation idea.
You don't "call" a userform. You instantiate it, and then you Show it.
UserForm is the "base class" from which all userforms are derived. See there is inheritance in VBA, only not with custom classes.
So you have a UserForm2 class, a UserForm3 class, a UserForm4 class, and so on.
These classes need to be instantiated before they can be used.
Dim theForm As UserForm
Set theForm = New UserForm2
theForm.Show
Set theForm = New UserForm3
theForm.Show
'...
So what you need is a way to parameterize this Set theForm = New ????? part.
And you can't. Because whatever you're going to do, the contents of a cell is going to be a string, and there's no way you can get an instance of a UserForm3 out of a String that says "UserForm3".
Make a factory function that does the translation:
Public Function CreateForm(ByVal formName As String) As UserForm
Select Case formName
Case "UserForm1"
Set CreateForm = New UserForm1
Case "UserForm2"
Set CreateForm = New UserForm2
Case "UserForm3"
Set CreateForm = New UserForm3
'...
End Select
End Function
And then call that function to get your form object:
Set form = CreateForm(wsControls.Cells(loop2, 8).Value)
If Not form Is Nothing Then form.Show

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