This is my code that tries to set the text of a ComboBox when I click an item in a ListView.
Private Sub ListView1_Click()
If ListView1.ListItems.Count > 0 Then
Text1.Text = ListView1.ListItems(ListView1.SelectedItem.Index).Text
Text2.Text = ListView1.ListItems(ListView1.SelectedItem.Index).ListSubItems(1).Text
Sql = "SELECT A.AID,B.LOC_NAME,C.SNAME FROM ASSET A,LOCATION B,SUPPLIER C WHERE "
Sql = Sql + "A.LOC_ID=B.LOC_ID AND A.SUP_ID=C.SUP_ID AND AID=" & Text1.Text
RS.Open Sql, CON, 1, 2
COM1
Combo1.Text = RS!LOC_NAME //combo with style - 2
COM5
Combo5.Text = RS!SNAME //combo with style - 2
End If
End Sub
Private Sub COM5()
If Combo5.ListIndex = -1 Then
For I = 0 To Combo5.ListCount - 1
Combo5.ListIndex = I
Next
End If
End Sub
Private Sub COM1()
If Combo1.ListIndex = -1 Then
For I = 0 To Combo1.ListCount - 1
Combo1.ListIndex = I
Next
End If
End Sub
However, when I click on the ListView1, I get this error:
'text' property is read only
Can anyone explain why?
For a combobox with the dropdown list style you can only select an item with .text if that item already exists, so combo1.text = "xxx" errors if "xxx" is not present in the list.
To select or add based on existence you can;
Private Sub SelectOrAddToCombo(combo As ComboBox, value As String)
Dim i As Long
With combo
For i = 0 To combo.ListCount - 1
If StrComp(.List(i), value, vbTextCompare) = 0 Then
combo.ListIndex = i
Exit Sub
End If
Next
.AddItem value
.ListIndex = .NewIndex
End With
End Sub
...
SelectOrAddToCombo Combo1, RS!LOC_NAME
SelectOrAddToCombo Combo5, RS!SNAME
It's not clear what the point of your COM5()/COM1() routines are.
For the listview, rather than click look at the
ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
event which passes you the clicked item negating the need for ListView1.SelectedItem (which can cause errors if its Nothing).
yes, you must populate the combobox with the array(using additem value) before set the .text propierty, if the text that you want to set on the combobox does not exits in the array you get this error
Related
I have a code which I would like to use on multiple sheets, except one sheet. But applying the code to alle sheets is also fine.
Here is the code that I would like to adjust. I am have currently applied it to Excel 2011 in OS X , but I would like to use it for Excel 2010 in Windows.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Dim the_selection As String
Dim month_in_review As String
the_selection = Sheet1.Range("A1")
Dim Rep As Integer
For Rep = 2 To 379
the_column = GetColumnLetter_ByInteger(Rep)
month_in_review = Sheet1.Range(the_column & "1")
If the_selection = month_in_review Then
Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = False
Else
Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = True
End If
Next Rep
End If
End Sub
In the module I have the following code:
Public Function GetColumnLetter_ByInteger(what_number As Integer) As String
GetColumnLetter_ByInteger = ""
MyColumn_Integer = what_number
If MyColumn_Ineger <= 26 Then
column_letter = ChrW(64 + MyColumn_Integer)
End If
If MyColumn_Integer > 26 Then
column_letter = ChrW(Int((MyColumn_Integer - 1) / 26) + 64) & ChrW(((MyColumn_Integer - 1) Mod 26) + 65)
End If
GetColumnLetter_ByInteger = column_letter
End Function
If you're asking for one sheet to detect the change in cell "A1" and then to hide/unhide columns on multiple sheets then the prior answers to your question will serve you nicely.
If, on the other hand, you're asking to detect a change in cell "A1" on any sheet and then to hide/unhide columns on just the changed sheet, then the code below will work for you. It accesses the Workbook_SheetChanged event at Workbook level.
A few points about your code:
You can reference cells using their integer or address values with the .Cell property, so Sheet1.Cells(1, 1) is the same as Sheet1.Cells(1, "A"). The same applies to the .Columns property. So there's no real need to convert your integer values to a string. See #Florent B's answer for a good example of this.
Wherever possible, minimise looping sheet interactions as these are very time-consuming. So rather than loop through the columns and hide/unhide each one individually, you could assign them to ranges within your loop and then hide/unhide the ranges all in one go at the end of your loop. If you must interact with the sheet on each iteration of your loop, then set the Application.ScreenUpdating property to false before the start of your loop. There's an example of this property in the sample code below.
Put this in your Workbook module:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const TARGET_ADDRESS As String = "A1"
Dim cell As Range
Dim hiddenCols As Range
Dim unhiddenCols As Range
Dim selectedMonth As String
Dim monthInReview As String
Dim c As Integer
'Ignore event if not a target worksheet
If Sh.Name = "Not Wanted" Then Exit Sub
'Ignore event if not in target range
Set cell = Target.Cells(1)
If cell.Address(False, False) <> TARGET_ADDRESS Then Exit Sub
'Criteria met, so handle event
selectedMonth = CStr(cell.Value)
For c = 2 To 379
Set cell = Sh.Cells(1, c)
monthInReview = CStr(cell.Value)
'Add cell to hidden or unhidden ranges
If monthInReview = selectedMonth Then
If unhiddenCols Is Nothing Then
Set unhiddenCols = cell
Else
Set unhiddenCols = Union(unhiddenCols, cell)
End If
Else
If hiddenCols Is Nothing Then
Set hiddenCols = cell
Else
Set hiddenCols = Union(hiddenCols, cell)
End If
End If
Next
'Hide and unhide the cells
Application.ScreenUpdating = False 'not really needed here but given as example
If Not unhiddenCols Is Nothing Then
unhiddenCols.EntireColumn.Hidden = False
End If
If Not hiddenCols Is Nothing Then
hiddenCols.EntireColumn.Hidden = True
End If
Application.ScreenUpdating = True
End Sub
You can use a for each loop to loop through all the Worksheets, and check the worksheet name if it should be skipped. Then apply your code onto the sheet selected.
Something like:
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Skip Sheet" Then
Dim the_selection As String
Dim month_in_review As String
the_selection = ws.Range("A1")
Dim Rep As Integer
For Rep = 2 To 379
the_column = GetColumnLetter_ByInteger(Rep)
month_in_review = ws.Range(the_column & "1")
If the_selection = month_in_review Then
ws.Range(the_column & ":" & the_column).EntireColumn.Hidden = False
Else
ws.Range(the_column & ":" & the_column).EntireColumn.Hidden = True
End If
Next Rep
End If
Next ws
End If
End Sub
I wasn't entirely sure what you wished to achieve, so i put ws in the place of Sheet1.
This example will show/hide the columns in all the other sheets if the first cell of the column match/differ with the cell A1 of the sheet where this code is placed:
Private Sub Worksheet_Change(ByVal Target As Range)
' exit if not cell A1
If Target.row <> 1 Or Target.column <> 1 Then Exit Sub
Dim sheet As Worksheet
Dim the_selection As String
Dim month_in_review As String
Dim column As Integer
the_selection = Target.Value
' iterate all the sheets
For Each sheet In ThisWorkbook.Worksheets
' skip this sheet
If Not sheet Is Me Then
' iterate the columns
For column = 2 To 379
' get the first cell of the column
month_in_review = sheet.Cells(1, column).Value
' hide or show the column if it's a match or not
sheet.Columns(column).Hidden = month_in_review <> the_selection
Next
End If
Next
End Sub
I was working on a system in VBA word. The goal of the system is to replace several different words in a document with input from a text box. So far I have a userform with 12 different text boxes each containing input from a user to replace words in the document. I made a button in the userform to print all the input from the textboxes to the document.
For each textbox I made the following code:
Sub FindAndReplaceAllStoriesHopefully()
Dim myStoryRange As Range
'
'
'Loop replaces everything with <KLANTNAAM> in the document
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "<KLANTNAAM>"
.Replacement.Text = TextBox1.Value
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
With myStoryRange.Find
.Text = "<KLANTNAAM>"
.Replacement.Text = TextBox1.Value
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Loop
Next myStoryRange
So far I did this for all 12 textboxes and it works but it isn't smooth. The
button upon getting clicked is calling the function with
Call FindAndReplaceAllStoriesHopefully
I have a few problems which I just cannot fix:
Once the button is clicked and some textboxes are not filled by the user, the marked words like <KLANTNAAM> are still replaced and removed from the document.
The performance of the macro is not great since the same code is copied 12 times.
Once the button is clicked, there is no easy way for the user to undo mistakes typed in the userform since the results are already printed.
I was hoping to get some tips so I can finalize this application.
Something like this:
Private Sub CommandButton1_Click()
Dim numBlank As Long, n As Long, txt As String
Dim bookMarkName As String
numBlank = Me.CountBlanks
If numBlank > 0 Then
If MsgBox(numBlank & " entries are blank!. Continue?", _
vbExclamation + vbOKCancel) <> vbOK Then
Exit Sub
End If
End If
For n = 1 To 4
txt = Me.Controls("Textbox" & n).Text
bookMarkName = "BOOKMARK" & n
FindAndReplaceAllStoriesHopefully bookMarkName, txt
Next n
End Sub
Function CountBlanks() As Long
Dim n As Long, b As Long
b = 0
For n = 1 To 4
If Len(Me.Controls("Textbox" & n).Text) = 0 Then
b = b + 1
End If
Next n
CountBlanks = n
End Function
In VB 6 How can I refer to control label using a variable instead of a fixed name such as LUH01 (as below) which does not allow a Loop.
Frm_Dispo_Prof_Grille.LUH01.BackColor = &HFF00&
You can refer to it via the Controls Collection:
Frm_Dispo_Prof_Grille.Controls("LUH01").BackColor = &HFF00&
Be careful, however. If you need to refer to a property/method that is not one of the standard/built-in ones, you'll have to cast the control to a type:
Dim lbl as Label
Set lbl = Frm_Dispo_Prof_Grille.Controls("LUH01")
lbl.BackColor = &HFF00
I think you want to create a control array
You can do that by creating 1 control, and set its Index property to 0 (instead of empty)
You can then Load new controls and use them all in a loop
For example to load some command buttons and position them in a loop:
'1 form with :
' 1 command button: name=Command1 index=0
'Number of command buttons to use in the loop
Private Const NRBUTTONS As Integer = 5
Option Explicit
Private Sub Form_Load()
Dim intIndex As Integer
'change the caption of the default button
Command1(0).Caption = "Button 0"
For intIndex = 1 To NRBUTTONS - 1
'load an extra command button
Load Command1(intIndex)
'change the caption of the newly loaded button
Command1(intIndex).Caption = "Button " & CStr(intIndex)
'newly load command buttons are invisible by deafult
'make the new command button visible
Command1(intIndex).Visible = True
Next intIndex
End Sub
Private Sub Form_Resize()
'arrange all loaded command buttons via a loop
Dim intIndex As Integer
Dim sngWidth As Single
Dim sngHeight As Single
sngWidth = ScaleWidth
sngHeight = ScaleHeight / NRBUTTONS
For intIndex = 0 To NRBUTTONS - 1
Command1(intIndex).Move 0, intIndex * sngHeight, sngWidth, sngHeight
Next intIndex
End Sub
How do I set SelectedIndex of a DataGridViewComboBoxCell?
The code fill the combobox with items, but I need to select one of them
My Code:
Dim cListItems As New System.Collections.Generic.List(Of Combobox_values)
If ds.Tables("items_prices").Rows(0).Item("item_selldozen") > 0 Then
Dim item_selldozen As String = ds.Tables("items_prices").Rows(0).Item("item_selldozen")
cListItems.Add(New Combobox_values("Docena (" + item_selldozen + ")", item_selldozen))
End If
Dim dgvcbc As DataGridViewComboBoxCell = DirectCast(CType(main.ActiveMdiChild, discount_new_discount).discountitems_new_discount.Rows(last_row).Cells(3), DataGridViewComboBoxCell)
dgvcbc.DataSource = cListItems 'Fill Remote Comboboxcell
dgvcbc.DisplayMember = "Text"
dgvcbc.ValueMember = "Value"
If you have a ComboBoxColumn in your DataGridView and you want to know what is the selected index of the combo box, then you need to do this:
Handle the EditingControlShowing event of DataGridView. In this event handler, check if the current column is of our interest. Then we
create a temporary ComboBox object and get the selected index:
Private Sub dataGridView1_EditingControlShowing(sender As Object, e As DataGridViewEditingControlShowingEventArgs)
If dataGridView1.CurrentCell.ColumnIndex = 0 Then
' Check box column
Dim comboBox As ComboBox = TryCast(e.Control, ComboBox)
comboBox.SelectedIndexChanged += New EventHandler(AddressOf comboBox_SelectedIndexChanged)
End If
End Sub
Private Sub comboBox_SelectedIndexChanged(sender As Object, e As EventArgs)
Dim selectedIndex As Integer = DirectCast(sender, ComboBox).SelectedIndex
MessageBox.Show("Selected Index = " & selectedIndex)
End Sub
I would like to add a Control and an associated event at runtime in Excel using VBA but I don't know how to add the events.
I tried the code below and the Button is correctly created in my userform but the associated click event that should display the hello message is not working.
Any advice/correction would be welcome.
Dim Butn As CommandButton
Set Butn = UserForm1.Controls.Add("Forms.CommandButton.1")
With Butn
.Name = "CommandButton1"
.Caption = "Click me to get the Hello Message"
.Width = 100
.Top = 10
End With
With ThisWorkbook.VBProject.VBComponents("UserForm1.CommandButton1").CodeModule
Line = .CountOfLines
.InsertLines Line + 1, "Sub CommandButton1_Click()"
.InsertLines Line + 2, "MsgBox ""Hello!"""
.InsertLines Line + 3, "End Sub"
End With
UserForm1.Show
The code for adding a button at runtime and then to add events is truly as simple as it is difficult to find out. I can say that because I have spent more time on this perplexity and got irritated more than in anything else I ever programmed.
Create a Userform and put in the following code:
Option Explicit
Dim ButArray() As New Class2
Private Sub UserForm_Initialize()
Dim ctlbut As MSForms.CommandButton
Dim butTop As Long, i As Long
'~~> Decide on the .Top for the 1st TextBox
butTop = 30
For i = 1 To 10
Set ctlbut = Me.Controls.Add("Forms.CommandButton.1", "butTest" & i)
'~~> Define the TextBox .Top and the .Left property here
ctlbut.Top = butTop: ctlbut.Left = 50
ctlbut.Caption = Cells(i, 7).Value
'~~> Increment the .Top for the next TextBox
butTop = butTop + 20
ReDim Preserve ButArray(1 To i)
Set ButArray(i).butEvents = ctlbut
Next
End Sub
Now you need to add a Class Module to your code for the project. Please remember it's class module, not Standard Module.
The Object butEvents is the button that was clicked.
Put in the following simple code (in my case the class name is Class2).
Public WithEvents butEvents As MSForms.CommandButton
Private Sub butEvents_click()
MsgBox "Hi Shrey from " & butEvents.Caption
End Sub
That's it. Now run it!
Try this:
Sub AddButtonAndShow()
Dim Butn As CommandButton
Dim Line As Long
Dim objForm As Object
Set objForm = ThisWorkbook.VBProject.VBComponents("UserForm1")
Set Butn = objForm.Designer.Controls.Add("Forms.CommandButton.1")
With Butn
.Name = "CommandButton1"
.Caption = "Click me to get the Hello Message"
.Width = 100
.Top = 10
End With
With objForm.CodeModule
Line = .CountOfLines
.InsertLines Line + 1, "Sub CommandButton1_Click()"
.InsertLines Line + 2, "MsgBox ""Hello!"""
.InsertLines Line + 3, "End Sub"
End With
VBA.UserForms.Add(objForm.Name).Show
End Sub
This permanently modifies UserForm1 (assuming you save your workbook). If you wanted a temporary userform, then add a new userform instead of setting it to UserForm1. You can then delete the form once you're done with it.
Chip Pearson has some great info about coding the VBE.
DaveShaw, thx for this code man!
I have used it for a togglebutton array (put a 'thumbnail-size' picture called trainer.jpg in the same folder as the excel file for a togglebutton with a picture in it). In the 'click' event the invoker is also available (by the object name as a string)
In the form:
Dim CreateTrainerToggleButtonArray() As New ToggleButtonClass
Private Sub CreateTrainerToggleButton(top As Integer, id As Integer)
Dim pathToPicture As String
pathToPicture = ThisWorkbook.Path & "\trainer.jpg"
Dim idString As String
idString = "TrainerToggleButton" & id
Dim cCont As MSForms.ToggleButton
Set cCont = Me.Controls.Add _
("Forms.ToggleButton.1")
With cCont
.Name = idString
.Width = 20
.Height = 20
.Left = 6
.top = top
.picture = LoadPicture(pathToPicture)
End With
ReDim Preserve CreateTrainerToggleButtonArray(1 To id)
Set CreateTrainerToggleButtonArray(id).ToggleButtonEvents = cCont
CreateTrainerToggleButtonArray(id).ObjectName = idString
End Sub
and a class "ToggleButtonClass"
Public WithEvents ToggleButtonEvents As MSForms.ToggleButton
Public ObjectName As String
Private Sub ToggleButtonEvents_click()
MsgBox "DaveShaw is the man... <3 from your friend: " & ObjectName
End Sub
Now just simple call from UserForm_Initialize
Private Sub UserForm_Initialize()
Dim index As Integer
For index = 1 To 10
Call CreateTrainerToggleButton(100 + (25 * index), index)
Next index
End Sub
This was my solution to add a commandbutton and code without using classes
It adds a reference to allow access to vbide
Adds the button
Then writes a function to handle the click event in the worksheet
Sub AddButton()
Call addref
Set rng = DestSh.Range("B" & x + 3)
'Set btn = DestSh.Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=rng.Left, Top:=rng.Top, Height:=rng.Height * 3, Width:=rng.Width * 3)
DoEvents
With myButton
'.Placement = XlPlacement.xlFreeFloating
.Object.Caption = "Export"
.Name = "BtnExport"
.Object.PicturePosition = 1
.Object.Font.Size = 14
End With
Stop
myButton.Object.Picture = LoadPicture("F:\Finalised reports\Templates\Macros\evolution48.bmp")
Call CreateButtonEvent
End Sub
Sub addref()
On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End Sub
Private Sub CreateButtonEvent()
On Error GoTo errtrap
Dim oXl As Application: Set oXl = Application
oXl.EnableEvents = False
oXl.DisplayAlerts = False
oXl.ScreenUpdating = False
oXl.VBE.MainWindow.Visible = False
Dim oWs As Worksheet
Dim oVBproj As VBIDE.VBProject
Dim oVBcomp As VBIDE.VBComponent
Dim oVBmod As VBIDE.CodeModule '
Dim lLine As Single
Const QUOTE As String = """"
Set oWs = Sheets("Contingency")
Set oVBproj = ThisWorkbook.VBProject
Set oVBcomp = oVBproj.VBComponents(oWs.CodeName)
Set oVBmod = oVBcomp.CodeModule
With oVBmod
lLine = .CreateEventProc("Click", "BtnExport") + 1
.InsertLines lLine, "Call CSVFile"
End With
oXl.EnableEvents = True
oXl.DisplayAlerts = True
Exit Sub
errtrap:
End Sub
An easy way to do it:
1 - Insert a class module and write this code:
Public WithEvents ChkEvents As MSForms.CommandButton
Private Sub ChkEvents_click()
MsgBox ("Click Event")
End Sub
2 - Insert a userform and write this code:
Dim Chk As New Clase1
Private Sub UserForm_Initialize()
Dim NewCheck As MSForms.CommandButton
Set NewCheck = Me.Controls.Add("Forms.CommandButton.1")
NewCheck.Caption = "Prueba"
Set Chk.ChkEvents = NewCheck
End Sub
Now show the form and click the button
I think the code needs to be added to the Userform, not to the button itself.
So something like
With UserForm1.CodeModule
'Insert code here
End With
In place of your With ThisWorkbook