VBA excel 2007, ComboBox "Permission Denied" - vba

I'm a beginner with VBA, I'm developing a macro on excel 2007 and I'm having some problems with the ComboBox. Anywhere I try to add items i always get the error 70 "Permission Denied". What is my mistake?
Below you can find my simple code
Private Sub CommandButton2_Click()
Dim pic As IPictureDisp
Set pic = UserForm1.Image1.Picture
'stdole.SavePicture pic, "ciao"
Call SavePicture(pic, "ciao.jpg")
End Sub
Private Sub CommandButton3_Click()
Dim MyChart As Chart
Dim ChartData As Range
Dim ChartName As String
ChartName = "ANCONA"
Set ChartData = ActiveSheet.Range("A1:A9")
Application.ScreenUpdating = True
'UserForm1.Image4.Picture = LoadPicture("C:\Users\rfori\Desktop\PROGETTO
MARTINA\parto_trig.jpg")
'
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
With MyChart.SeriesCollection.NewSeries
.Name = ChartName
.Values = ChartData
.XValues = ActiveSheet.Range("B1:B9")
End With
Dim imageName As String
imageName = "prova.jpg"
MyChart.Export Filename:=imageName, FilterName:="jpg"
Application.ScreenUpdating = True
UserForm1.Image1.Picture = LoadPicture("prova.jpg")
'MyChart.SeriesCollection(1).Name = ChartName
'MyChart.SetSourceData Source:=ChartData
End Sub
Private Sub UserForm_Activate()
ComboBox1.AddItem "ciao"
End Sub
Private Sub UserForm_Initialize()
ComboBox1.AddItem "ciao"
With Me
.StartUpPosition = 1
.Width = MultiPage1.Width
.Height = MultiPage1.Height
.Left = Application.Left - (Application.Width * 0.85) \ 2
.Top = Application.Top - (Application.Height * 0.85) \ 2
End With
myarray1 = Array("Ancona", "Milano", "Palermo")
For x = 0 To 2
'ComboBox1.AddItem myarray1(x)
Next x
End Sub
Sub window_sizer()
With ActiveWindow
.WindowState = xlNormal`enter code here`
.Height = 75
.Width = 125
.ScrollColumn = 1
.ScrollRow = 1
End Sub
Thank you in advance

had the same problem before as described in Combobox additem permission denied error no.70
.
Make sure that the property ListFillRange is empty.

Related

Add code to dynamically added checkbox in form VBA

I wrote sub which add checkbox like below
Sub WstawCHB(i As Integer, ByVal ws As Worksheet)
Dim NewCheckBox As MSForms.CheckBox
Set NewCheckBox = ListaObecnosciForm.Controls.Add("Forms.Checkbox.1", "CB" & i, True)
With NewCheckBox
.Top = 20 * i
.Left = 20
.Width = 450
.Height = 24
.Caption = ws.Cells(2 + i, 27)
.Value = False
End With
End Sub
How to add some action to the checkbox in code. For example (.OnAction = "CheckBox1_Click")
Private Sub CheckBox1_Click()
MsgBox "Hello World!"
End Sub
Additional information: the Sub is calling in loop in code below, so I have to "inject" code for every created checkbox for each iteration of loop
Sub DodajCHB(ByVal LW As Integer, ByVal ws As Worksheet)
Dim i As Integer
i = 1
Do While i < LW
Call WstawCHB(i, ws)
i = i + 1
Loop
End Sub

How to dynamically create an element's position?

I have an Outlook userform to show selected emails.
Since listboxes cannot have text in the column-headers, I adapted the solution proposed here.
My Problem:
After intialization of the form, the header-box is at a wrong position and with a wrong size. Some checks show, that the correct values are allocated by the function createListboxHeader() - and without error. But checking the header-box's position and size after that function (back in initialization), the values are wrong - prove of what I see.
Sometimes it works correctly, but most of the times not.
Code:
Public Sub createListboxHeader(lstBody As ListBox, arrHeaders)
Dim lstHeader As ListBox
Dim i As Integer
'create new listbox for the header
Set lstHeader = Me.Controls.Add("Forms.ListBox.1","NameOnlyForTesting")
With lstBody
'ensure properties of body-listbox
.ColumnHeads = False
.ZOrder (1)
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
End With
With lstHeader
'properties of header-listbox
.BackColor = RGB(200, 200, 200)
.Enabled = False
.ZOrder (0)
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
'make column equal
.ColumnCount = lstBody.ColumnCount
.ColumnWidths = lstBody.ColumnWidths
'add header elements
.AddItem
For i = 0 To UBound(arrHeaders)
.List(0, i) = arrHeaders(i)
Next i
'positioning of header-listbox
.Height = 10
.Width = lstBody.Width
.Left = lstBody.Left
.Top = (lstBody.Top - lstHeader.Height) - 0
Debug.Print lstBody.Width, lstHeader.Height ' <-- show both '400'
End With
End Sub
Usage:
Private Sub UserForm_Initialize()
'find emails
Dim selEmails As Outlook.Selection
Set selEmails = getSelectedEmails() 'function not displayed here at StackOverflow
'show emails in List-Box
Call printSelectedEmailsInList(selEmails)
End Sub
Private Sub printSelectedEmailsInList(selectedEmails As Outlook.Selection)
Dim objEmail As Outlook.MailItem
Dim intCounter As Integer
Dim arrHeaders() As Variant
With Me.lstSelectedEmails
'configure listbox
.Clear
.ColumnCount = 5
.ColumnWidths = "70;100;100;200;100"
'configute header (AFTER body!)
arrHeaders = Array("Date", "From", "To", "Subject", "Folder")
Call createListboxHeader(Me.lstSelectedEmails, arrHeaders)
MsgBox Me.Controls("NameOnlyForTesting").Width '<-- shows'78' instead of '400'
'fill list with emails
intCounter = 0
For Each objEmail In selectedEmails
.AddItem
.List(intCounter, 0) = objEmail.SentOn
.List(intCounter, 1) = objEmail.SenderName
.List(intCounter, 2) = objEmail.To
.List(intCounter, 3) = objEmail.Subject
.List(intCounter, 4) = objEmail.Parent.Name
intCounter = intCounter + 1
Next
End With
End Sub
I solved my problem, by changing:
Private Sub UserForm_Initialize()
[...]
End Sub
to:
Private Sub UserForm_Activate()
[...]
End Sub

Excel VBA Runtime Error 9 but not when stepping through the code

What would the reason be for a VBA user form with an EventHandler class to throw a Run-time error '9': Subscript out of range
BUT
If I F8 and step into the UserForm code I can step right through the entire code without it crashing
Just for simplicity here is my event handler class LabelEventHandler
Private WithEvents Innerlabel As MSForms.Label
Private InnerRow As Integer
Private InnerSheet As Worksheet
Public Property Set Label(ByVal InLabel As MSForms.Label)
Set Innerlabel = InLabel
End Property
Public Property Let Row(ByVal InRow As Integer)
InnerRow = InRow
End Property
Public Property Set Sheet(ByVal InSheet As Worksheet)
Set InnerSheet = InSheet
End Property
Private Sub InnerLabel_Click()
Dim Frame As MSForms.Frame
Dim ChildLabel As MSForms.Label
Set Frame = Innerlabel.Parent
For Each ChildLabel In Frame.Controls
Select Case ChildLabel.Name
Case "FullName"
InnerSheet.Cells(InnerRow, 4).Value = ChildLabel.Caption
Case "Email"
InnerSheet.Cells(InnerRow, 5).Value = ChildLabel.Caption
Case "Phone"
InnerSheet.Cells(InnerRow, 6).Value = ChildLabel.Caption
End Select
Next
End Sub
and here is the UserForm code
Private Sheet As Worksheet
Private LabelClickArray() As New LabelEventHandler
Public Sub AddUser(FullName As String, Email As String, Phone As String)
Dim FullNameLabel As MSForms.Label
Dim EmailLabel As MSForms.Label
Dim PhoneLabel As MSForms.Label
Dim UserFrame As Frame
Dim Top
Top = FindBottomUserRow()
Set UserFrame = Me.Controls.Add("Forms.Frame.1")
With UserFrame
.Top = Top
.Left = 5
.Width = 660
.Height = 20
.Font.Name = "Verdana"
.Font.Size = 12
.Font.Weight = 400
.Caption = ""
.BorderStyle = fmBorderStyleNone
End With
Set FullNameLabel = UserFrame.Controls.Add("Forms.Label.1")
Set EmailLabel = UserFrame.Controls.Add("Forms.Label.1")
Set PhoneLabel = UserFrame.Controls.Add("Forms.Label.1")
With FullNameLabel
.Top = 0
.Left = 0
.Width = 200
.Height = 15
.Name = "FullName"
.Caption = FullName
End With
With EmailLabel
.Top = 0
.Left = 205
.Width = 300
.Height = 15
.Name = "Email"
.Caption = Email
End With
With PhoneLabel
.Top = 0
.Left = 510
.Width = 150
.Height = 15
.Name = "Phone"
.Caption = Phone
End With
ReDim Preserve LabelClickArray(UBound(LabelClickArray) + 3)
Set LabelClickArray(UBound(LabelClickArray) - 2).Label = FullNameLabel
Set LabelClickArray(UBound(LabelClickArray) - 1).Label = EmailLabel
Set LabelClickArray(UBound(LabelClickArray)).Label = PhoneLabel
Set LabelClickArray(UBound(LabelClickArray) - 2).Sheet = Sheet
Set LabelClickArray(UBound(LabelClickArray) - 1).Sheet = Sheet
Set LabelClickArray(UBound(LabelClickArray)).Sheet = Sheet
LabelClickArray(UBound(LabelClickArray) - 2).Row = ActiveCell.Row
LabelClickArray(UBound(LabelClickArray) - 1).Row = ActiveCell.Row
LabelClickArray(UBound(LabelClickArray)).Row = ActiveCell.Row
End Sub
Function FindBottomUserRow()
Dim Frame As Control
Dim Top
Top = 30
For Each Frame In Me.Controls
If (TypeName(Frame) = "Frame" And Frame.Top > Top) Then Top = Frame.Top
Next
If (Top > 30) Then Top = Top + 20
FindBottomUserRow = Top
End Function
Private Sub UserForm_Initialize()
Set Sheet = ActiveSheet
Me.AddUser "Ryan", "ryan#r.com", "2625"
Me.AddUser "Jeff", "j#k.com", "123-4567"
End Sub
The error
Your error happens at the ReDim Preserve command, because you never initialized the array. You cannot execute a UBound-function to a non-initialized array (if you try, you get the Runtime error 9). If you cannot be sure at runtime if your array in already initialized, change your code to:
If IsArrayAllocated(LabelClickArray) Then
ReDim Preserve LabelClickArray(UBound(LabelClickArray) + 3)
Else
ReDim LabelClickArray(3)
End If
The function IsArrayAllocated looks like this:
Function IsArrayAllocated(arr As Variant) As Boolean
On Error Resume Next
IsArrayAllocated = IsArray(arr) _
And Not IsError(LBound(arr, 1)) _
And LBound(arr, 1) <= UBound(arr, 1)
End Function
(Code copied from cpearson)

Using loops for Checkbox

I am trying to generate a GUI in excel which plots and unplots data on a single chart depending on whether the checkbox is selected or not.
The vba script :
Private Sub UserForm_Initialize()
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = "=Sheet1!$A$21:$A$23"
ActiveChart.SeriesCollection(1).Values = "=Sheet1!$B$21:$B$23"
With ActiveChart.Parent
.Height = 300 ' resize
.Width = 600 ' resize
.Top = 100 ' reposition
.Left = 100 ' reposition
End With
End Sub
Private Sub CheckBox1_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "3bar,pH7,30C"
ActiveChart.SeriesCollection(2).XValues = "=Sheet1!$D$21:$D$223"
ActiveChart.SeriesCollection(2).Values = "=Sheet1!$E$21:$E$223"
End Sub
Private Sub CheckBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ActiveChart.SeriesCollection(2).Delete
End Sub
Private Sub CheckBox2_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "3bar,pH7,20C"
ActiveChart.SeriesCollection(3).XValues = "=Sheet1!$G$21:$G$223"
ActiveChart.SeriesCollection(3).Values = "=Sheet1!$H$21:$H$223"
End Sub
Private Sub CheckBox3_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).Name = "3bar,pH7,10C"
ActiveChart.SeriesCollection(4).XValues = "=Sheet1!$J$21:$J$223"
ActiveChart.SeriesCollection(4).Values = "=Sheet1!$K$21:$K$223"
End Sub
Private Sub CheckBox4_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(5).Name = "3bar,pH5,30C"
ActiveChart.SeriesCollection(5).XValues = "=Sheet1!$M$21:$M$223"
ActiveChart.SeriesCollection(5).Values = "=Sheet1!$N$21:$N$223"
End Sub
Private Sub CheckBox5_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(6).Name = "3bar,pH5,20C"
ActiveChart.SeriesCollection(6).XValues = "=Sheet1!$P$21:$P$223"
ActiveChart.SeriesCollection(6).Values = "=Sheet1!$Q$21:$Q$223"
End Sub
Private Sub CheckBox6_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(7).Name = "3bar,pH5,20C(DI)"
ActiveChart.SeriesCollection(7).XValues = "=Sheet1!$S$21:$S$223"
ActiveChart.SeriesCollection(7).Values = "=Sheet1!$T$21:$T$223"
End Sub
Private Sub CheckBox7_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(8).Name = "3bar,pH5,20C(HNO3)"
ActiveChart.SeriesCollection(8).XValues = "=Sheet1!$V$21:$V$223"
ActiveChart.SeriesCollection(8).Values = "=Sheet1!$W$21:$W$223"
End Sub
Private Sub CheckBox8_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(9).Name = "3bar,pH5,10C"
ActiveChart.SeriesCollection(9).XValues = "=Sheet1!$Y$21:$Y$223"
ActiveChart.SeriesCollection(9).Values = "=Sheet1!$Z$21:$Z$223"
End Sub
Private Sub CheckBox9_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(10).Name = "3bar,pH9,20C"
ActiveChart.SeriesCollection(10).XValues = "=Sheet1!$AB$21:$AB$223"
ActiveChart.SeriesCollection(10).Values = "=Sheet1!$AC$21:$AC$223"
End Sub
Private Sub CheckBox10_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(11).Name = "3bar,pH9,10C"
ActiveChart.SeriesCollection(11).XValues = "=Sheet1!$AE$21:$AE$223"
ActiveChart.SeriesCollection(11).Values = "=Sheet1!$AF$21:$AF$223"
End Sub
Private Sub CheckBox11_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(12).Name = "5bar,pH5,20C"
ActiveChart.SeriesCollection(12).XValues = "=Sheet1!$AH$21:$AH$223"
ActiveChart.SeriesCollection(12).Values = "=Sheet1!$AI$21:$AI$223"
End Sub
Private Sub CheckBox12_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(13).Name = "1bar,pH5,20C"
ActiveChart.SeriesCollection(13).XValues = "=Sheet1!$AK$21:$AK$223"
ActiveChart.SeriesCollection(13).Values = "=Sheet1!$AL$21:$AL$223"
End Sub
Private Sub CheckBox13_Click()
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(14).Name = "0bar,pH5,20C"
ActiveChart.SeriesCollection(14).XValues = "=Sheet1!$AN$21:$AN$223"
ActiveChart.SeriesCollection(14).Values = "=Sheet1!$AO$21:$AO$223"
End Sub
A total of almost 60 checkbox definitions - 30 for clicking each of them and another 30 for unclicking them. .
The following are my issues:
(1) Instead of hardcoding for each 30 of the checkboxes, is it possible to define them using loop ? I am not sure how the checkbox name (CheckBox1, Checkbox2 etc.) can be defined as a variable and also how to create a generalized form for the commands
(2) The attempt to delete the dataset doesn't seem to work. eg: If I delete SeriesCollection(2), vba renumbers all other datasets which makes their id number irretrievable.
I would really appreciate any guidance regarding the same.
Create a custom class that would handle a group event for all the
comboboxes.
Add a class level collection to the userform to keep references to the custom class alive.
Create a table to lookup settings based on the Checkboxes index
Lookup Table Download
ControlWrapper Class Code
Public WithEvents ChartCheckbox As MSForms.CheckBox
Public index As Long
Private Sub ChartCheckbox_Click()
MsgBox index
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SeriesCollection.NewSeries
.SeriesCollection(index).Name = Application.VLookup(index, Range("ChartSettings"), 3, False)
.SeriesCollection(index).XValues = "=" & Application.VLookup(index, Range("ChartSettings"), 4, False)
.SeriesCollection(index).Values = "=" & Application.VLookup(index, Range("ChartSettings"), 5, False)
End With
End Sub
Userform Code
Private ControlsCollection As Collection
Private Sub UserForm_Initialize()
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = "=Sheet1!$A$21:$A$23"
ActiveChart.SeriesCollection(1).Values = "=Sheet1!$B$21:$B$23"
With ActiveChart.Parent
.Height = 300 ' resize
.Width = 600 ' resize
.Top = 100 ' reposition
.Left = 100 ' reposition
End With
' Initiate the Controls Collection
Dim ctrl
Dim wrapper As ControlWrapper
Set ControlsCollection = New Collection
For Each ctrl In Me.Controls
If TypeOf ctrl Is MSForms.CheckBox Then
Set wrapper = New ControlWrapper
Set wrapper.ChartCheckbox = ctrl
wrapper.index = Replace(ctrl.Name, "CheckBox", "")
ControlsCollection.Add wrapper
End If
Next
End Sub

Create event handlers for multiple dynamic controls

I have a userform that creates two dynamic control buttons but I am having difficulty accessing the .name property of the dynamic control, which means I can't create the event handler correctly. Due to this problem I am unable to create event handlers. Below shows the code that creates the dynamic controls and also the code that I have written for the event handlers (which isn't functioning correctly)
Option Explicit
Public WithEvents cButton As MSForms.CommandButton
Private Sub TextBox1_Change()
If TextBox1 <> vbNullString Then
For i = 1 To TextBox1.Value
Set cButton = Me.Controls.Add("Forms.CommandButton.1")
With cButton
.Name = "CommandButton" & i
.Left = 150
.Top = buttonStartPosition
.Width = 300
.Height = 140
End With
Next i
End If
End sub
Private Sub cButton_Click()
If cButton.Name = "CommandButton1" Then
MsgBox "Button1"
ElseIf cButton.Name = "CommandButton2" Then
MsgBox "Button2"
End If
End Sub
Once this code is executed and the two buttons are on the screen, I press the first button (button1) and nothing happens but when I press the second button (button2) I receive the message "Button2". So how come I can't access the first button?
#user3538102 .. To your comment regarding Textbox's. Below is example is an example. I added Combo box select either CommandButton or TextBox and generate events. The code works but could be better.
I added combo box to select to dynamically generate object type.
In UserForm Activate event - Add combo drop down list
Private Sub UserForm_Activate()
ComboBox1.AddItem "CommandButton"
ComboBox1.AddItem "TextBox"
ComboBox1.ListIndex = 0
End Sub
In Class1 Class Module ..
Modified UserForm code ..
Option Explicit
Dim cObjs() As New Class1
Private Sub TextBox1_Change()
Dim i As Integer
Dim buttonStartPosition As Integer
Dim cObj As Object
buttonStartPosition = 30
If TextBox1 <> vbNullString Then
For i = 1 To TextBox1.Value
If ComboBox1.Value = "CommandButton" Then
Set cObj = Me.Controls.Add("Forms.CommandButton.1")
Else
Set cObj = Me.Controls.Add("Forms.TextBox.1")
End If
With cObj
.Name = ComboBox1.Value & i
.Left = 15
.Top = buttonStartPosition
.Width = 30
.Height = 14
End With
ReDim Preserve cObjs(1 To i)
If ComboBox1.Value = "CommandButton" Then
Set cObjs(i).ButtonGroup = cObj
Else
Set cObjs(i).TextGroup = cObj
End If
buttonStartPosition = buttonStartPosition + 14
Next i
End If
End Sub
I got the events for multiple buttons to work with help from .. JWalk Excel Tips
Below is the modification based on your code and the link provided.
Create a Class module called "Class1"
Add modified code to UserForm1..
Option Explicit
Dim Buttons() As New Class1
Private Sub TextBox1_Change()
Dim i As Integer
Dim buttonStartPosition As Integer
Dim cButton As CommandButton
buttonStartPosition = 30
If TextBox1 <> vbNullString Then
For i = 1 To TextBox1.Value
Set cButton = Me.Controls.Add("Forms.CommandButton.1")
With cButton
.Name = "CommandButton" & i
.Left = 15
.Top = buttonStartPosition
.Width = 30
.Height = 14
End With
ReDim Preserve Buttons(1 To i)
Set Buttons(i).ButtonGroup = cButton
buttonStartPosition = buttonStartPosition + 14
Next i
End If
End Sub