Iam creating my labels and checkbox by code:
i = 1
While Not Sheets("I_M_1_1PW").Cells(9 + i, 43) = "koniec"
Set theLabel = UserForm1.Controls.Add("Forms.Label.1", labelCounter, True)
With theLabel
.Caption = Sheets("I_M_1_1PW").Cells(9 + i, 43)
.Left = 10
.Width = 100
.Top = 13 * labelCounter
Debug.Print labelCounter & " " & theLabel.Caption
End With
Set chkbox = UserForm1.Controls.Add("Forms.CheckBox.1", "CheckBox_" & i)
chkbox.Caption = Sheets("I_M_1_1PW").Cells(9 + i, 44)
chkbox.Left = 100
chkbox.Width = 75
chkbox.Top = 13 * labelCounter
i = i + 1
labelCounter = labelCounter + 1
I can search for active check box by code:
For j = 1 To Granica - 1
If UserForm1.Controls("CheckBox_" & j).Value = True Then
Wynik1 = UserForm1.Controls("CheckBox_" & j).Caption + Wynik1
'* Wzorce = Wzorce + UserForm1.label(j).Caption
End If
Next
But in '* place i got problem, cant take label.caption when iam using
UserForm1.Controls(j).Caption its looping through all parts parts of user.form not only labels.
you have to use
Wzorce = Wzorce + UserForm1.Controls(CStr(j)).Caption
here follows some other possible enhancements of your code
Dim theLabel As MSForms.Label, chkbox As MSForms.CheckBox
Dim Wynik1 As Variant, Wzorce As Variant
i = 1
While Not Sheets("I_M_1_1PW").Cells(9 + i, 43) = "koniec"
Set theLabel = UserForm1.Controls.Add("Forms.Label.1", i, True)
With theLabel
.Caption = Sheets("I_M_1_1PW").Cells(9 + i, 43)
.Left = 10
.Width = 100
.Top = 13 * i
Debug.Print i & " " & theLabel.Caption
End With
Set chkbox = UserForm1.Controls.Add("Forms.CheckBox.1", "CheckBox_" & i)
With chkbox
.Caption = Sheets("I_M_1_1PW").Cells(9 + i, 44)
.Left = 100
.Width = 75
.Top = 13 * i
End With
i = i + 1
Wend
...
For j = 1 To Granica - 1
If UserForm1.Controls("CheckBox_" & j).Value = True Then
Wynik1 = chkboxes(j).Caption + Wynik1
Wzorce = Wzorce + UserForm1.Controls(j).Caption
End If
Next
Finally here follows same code above but with exploitation of control arrays, which can possibly make your code more readable and maintainable:
Dim theLabel As MSForms.Label, chkbox As MSForms.CheckBox
Dim labels() As MSForms.Label, chkboxes() As MSForms.CheckBox
i = 1
While Not Sheets("I_M_1_1PW").Cells(9 + i, 43) = "koniec"
Set theLabel = UserForm1.Controls.Add("Forms.Label.1", i, True)
With theLabel
.Caption = Sheets("I_M_1_1PW").Cells(9 + i, 43)
.Left = 10
.Width = 100
.Top = 13 * i
Debug.Print i & " " & theLabel.Caption
End With
ReDim Preserve labels(1 To i)
Set labels(i) = theLabel
Set chkbox = UserForm1.Controls.Add("Forms.CheckBox.1", "CheckBox_" & i)
With chkbox
.Caption = Sheets("I_M_1_1PW").Cells(9 + i, 44)
.Left = 100
.Width = 75
.Top = 13 * i
End With
ReDim Preserve chkboxes(1 To i)
Set chkboxes(i) = chkbox
i = i + 1
Wend
...
For j = 1 To Granica - 1
If chkboxes(j).Value = True Then
Wynik1 = chkboxes(j).Caption + Wynik1
Wzorce = Wzorce + labels(j).Caption
End If
Next
End Sub
Assuming your controls are in pairs, it should be:
Wzorce = Wzorce + UserForm1.Controls("" & j).Caption
though I think you should name the labels the same way you did the checkboxes.
Great it works.
Wzorce = Wzorce + UserForm1.Controls("label_" & j).Caption
Ty user3598756.
Related
All,
I have the below code which creates a dynamic userform based on a list located in an excel worksheet. (Please see picture below)
When the user selects submit I would like to extract all the answers from the user form into an excel file.
Does anyone know how I would do this as I have hit a brick wall in thoughts, the user form to my knowledge has to be built via vba as the list of Project ID & UR can vary from 1 line to thousands of lines.
Any help would be much appreciated.
Sub addLabel()
UserForm6.Show vbModeless
Dim theLabel As Object
Dim ComboBox1 As Object
Dim CommandApp As Object
Dim CommandCan As Object
Dim buttonheight As Long
Dim labelCounter As Long
For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
Set theLabel = UserForm6.Controls.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 10
.Width = 50
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Set ComboBox1 = UserForm6.Controls.Add("Forms.combobox.1", "Test" & c, True)
With ComboBox1
.AddItem "Approved"
.AddItem "Partially Approved"
.AddItem "Not Approved"
.Left = 190
.Width = 120
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 30
Else
.Top = 30 + (20 * (c.Row - 1))
buttonheight = 30 + (20 * (c.Row - 1))
End If
End With
Next c
For Each c In Sheets("Sheet1").Range("B1:B100")
If c.Value = "" Then Exit For
Set theLabel = UserForm6.Controls.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 90
.Width = 70
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Next c
With UserForm6
.Width = 340
.Height = buttonheight + 90
End With
Set CommandApp = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandApp
.Caption = "Submit"
.Left = 10
.Width = 140
.Font.Size = 10
.Top = buttonheight + 30
End With
Set CommandCan = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandCan
.Caption = "Cancel"
.Left = 170
.Width = 140
.Font.Size = 10
.Top = buttonheight + 30
End With
End Sub
You will need create variables to hold references to the newly created CommandButtons. By adding the WithEvents modifier you will be able to receive the CommandButton events.
Naming the controls after cell values is problematic. A better solution is to use the MSForms Control Tag property to hold your references. In my example below I add a qualified reference to the target cell.
Changed the subroutines name from addLabel to something more meaningful Show_UserForm6.
Combobox values as they are added.
Userform6 Module
Option Explicit
Public WithEvents CommandApp As MSForms.CommandButton
Public WithEvents CommandCan As MSForms.CommandButton
Private Sub CommandApp_Click()
Dim ctrl As MSForms.Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" Then
Range(ctrl.Tag).Value = ctrl.Value
End If
Next
End Sub
Private Sub CommandCan_Click()
Unload Me
End Sub
Refactored Code
Sub Show_UserForm6()
Const PaddingTop = 34, Left1 = 10, Left2 = 90, Left3 = 190
Dim c As Range
Dim Top As Single
Top = 34
With UserForm6
.Show vbModeless
For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
With getNewControl(.Controls, "Forms.Label.1", Left1, 50, 20, Top)
.Caption = c.Value
.Tag = "'" & c.Parent.Name & "'!" & c.Address
End With
With getNewControl(.Controls, "Forms.Label.1", Left2, 50, 20, Top)
.Caption = c.Offset(0, 1).Value
.Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
End With
With getNewControl(.Controls, "Forms.ComboBox.1", Left3, 120, 20, Top)
.List = Array("Approved", "Partially Approved", "Not Approved")
.Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
.Value = c.Offset(0, 2).Value
End With
Top = Top + 20
Next
Set .CommandApp = getNewControl(.Controls, "Forms.Commandbutton.1", 10, 140, 20, Top + 10)
With .CommandApp
.Caption = "Submit"
End With
Set .CommandCan = getNewControl(.Controls, "Forms.Commandbutton.1", 170, 140, 20, Top + 10)
With .CommandCan
.Caption = "Cancel"
End With
End With
End Sub
Function getNewControl(Controls As MSForms.Controls, ProgID As String, Left As Single, Width As Single, Height As Single, Top As Single) As MSForms.Control
Dim ctrl As MSForms.Control
Set ctrl = Controls.Add(ProgID)
With ctrl
.Left = Left
.Width = Width
.Font.Size = 10
.Top = Top
End With
Set getNewControl = ctrl
End Function
Generally I'd set up classes and collections to hold references to your new controls.
It can work with your current set up though. First off I'll suggest an aesthetic change:
Set the size of your frame to a static size that fits on your screen and add the two command buttons outside of this.
Size the frame so it sits inside the bounds of your form.
Change the ScrollBars property to 2 - fmScrollBarsVertical.
In your code:
Add a new variable
Dim fme As Frame
Set fme = UserForm6.Frame1
Update your references to UserForm6 so they reference fme instead when you add the labels and combobox:
Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)
.
.
Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True)
.
.
Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)
Outside your final loop add this line of code (you may have to play around with the maths to get the correct scroll height):
fme.ScrollHeight = buttonheight + 90
Remove the code that adds the two command buttons (as they're now static outside of the frame).
Now your whole form should sit on the page and you can scroll through the controls.
Double-click your command button to add a Click event to it:
Private Sub CommandButton1_Click()
Dim ctrl As Control
Dim x As Long
For Each ctrl In Me.Frame1.Controls
If TypeName(ctrl) = "ComboBox" Then
x = x + 1
ThisWorkbook.Worksheets("Sheet2").Cells(x, 1) = ctrl.Value
End If
Next ctrl
End Sub
The code will go through each combobox on the form and copy the selected value to Sheet2 in the workbook.
Edit:
All the code incorporating the changes I made.
Sub addLabel()
UserForm6.Show vbModeless
Dim theLabel As Object
Dim ComboBox1 As Object
Dim CommandApp As Object
Dim CommandCan As Object
Dim buttonheight As Long
Dim fme As Frame
Dim c As Variant
Dim labelCounter As Long
Set fme = UserForm6.Frame1
For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 10
.Width = 50
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True)
With ComboBox1
.AddItem "Approved"
.AddItem "Partially Approved"
.AddItem "Not Approved"
.Left = 190
.Width = 120
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 30
Else
.Top = 30 + (20 * (c.Row - 1))
buttonheight = 30 + (20 * (c.Row - 1))
End If
End With
Next c
For Each c In Sheets("Sheet1").Range("B1:B100")
If c.Value = "" Then Exit For
Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 90
.Width = 70
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Next c
fme.ScrollHeight = buttonheight + 90
End Sub
I am creating form controls in a custom userform and have having difficulty in accesing them after creation. The amount of ComboBoxes and TextBoxes depends on user input. I am using a CommandButton to figure the correct syntax, but am at a loss to find the control. I have used several different naming conventions inside the CommandButton_Click method and nothing works.
My code for the userform to create my controls is as follows:
Sub createDetails()
Dim details As Variant
details = TextBox3.Value
remainTot = TextBox2.Value
If TextBox3.Value = "" Or TextBox3.Value = 0 Then
MsgBox "Must have at least 1 detail"
Exit Sub
Else
End If
For i = 1 To details
n = i - 1
Dim SubPay As Control
Dim CatPay As Control
Dim AmtPay As Control
Set theLbl = frmInvoice.Controls.Add("Forms.Label.1", "lbl_" & i, True)
With theLbl
.Caption = "Detail " & i
.Left = 20
.Width = 60
.Top = n * 24 + 110
.Font.Size = 10
End With
Set SubPay = frmInvoice.Controls.Add("Forms.ComboBox.1", "SubComboBox_" & i, True)
With SubPay
.Top = 108 + (n * 24)
.Left = 60
.Height = 18
.Width = 100
.Name = "subBox" & i
.Font.Size = 10
.TabIndex = n * 3 + 6
.TabStop = True
.RowSource = "PayeeList"
End With
Set CatPay = frmInvoice.Controls.Add("Forms.ComboBox.1", "CatComboBox_" & i, True)
With CatPay
.Top = 108 + (n * 24)
.Left = 165
.Height = 18
.Width = 100
.Name = "catBox" & i
.Font.Size = 10
.TabIndex = n * 3 + 7
.TabStop = True
.RowSource = "CatList"
End With
Set AmtPay = frmInvoice.Controls.Add("Forms.TextBox.1", "AmtTextBox" & i, True)
With AmtPay
.Top = 108 + (n * 24)
.Left = 270
.Height = 18
.Width = 50
.Name = "amtBox" & i
.Font.Size = 10
.TabIndex = n * 3 + 8
.TabStop = True
End With
Next i
Dim TBox As Control
Set TBox = frmInvoice.Controls.Add("Forms.TextBox.1", "TotalLbl", True)
With TBox
.Top = 130 + ((details - 1) * 24)
.Left = 270
.Height = 18
.Width = 50
.Name = "totBox"
.Font.Size = 10
'.TabIndex = (details - 1) * 3 + 9
.TabStop = False
.Value = TextBox2.Value
End With
Set theLbl = frmInvoice.Controls.Add("Forms.Label.1", "totLbl", True)
With theLbl
.Caption = "Total"
.Left = 225
.Width = 40
.Top = 135 + ((details - 1) * 24)
.Font.Size = 10
End With
frmInvoice.Height = 200 + details * 24
With CommandButton1
.Top = 150 + details * 24
.TabStop = True
.TabIndex = (details - 1) * 3 + 9
End With
With CommandButton2
.Top = 150 + details * 24
.TabStop = False
'.TabIndex = (details - 1) * 3 + 10
End With
End Sub
The code for the CommndButton which doesn't work is:
Private Sub CommandButton1_Click()
frmInvoice.Controls("amtBox1").Value = 1
frmInvoice.Controls(amtBox1).Value = 2
frmInvoice.Controls(AmtTextBox1).Value = 3
frmInvoice.Controls("AmtTextBox1").Value = 4
End Sub
Any help is greatly appreciated.
Screen shot of my userform:
Try using
frmInvoice.Controls("amtBox1").Text
instead of
frmInvoice.Controls("amtBox1").Value
I think your error because of
Private Sub CommandButton1_Click()
frmInvoice.Controls("amtBox1").Value = 1 'is true
frmInvoice.Controls(amtBox1).Value = 2 'is false because there isn't double quotes
frmInvoice.Controls(AmtTextBox1).Value = 3 'is false because there isn't dobule quotes
frmInvoice.Controls("AmtTextBox1").Value = 4 'is false the AmtTextBoxt1 name is changed "amtBox1"
End Sub
Maby, Do you want to this?
Private Sub CommandButton1_Click()
Dim i As Integer
Dim total As Currency
With frmInvoice
For i = 1 To TextBox3.Value
total = total + .Controls("amtBox" & i).Value
Next i
.Controls("totBox").Text = Format(total, "####.00")
End With
End Sub
I have made a userform which automatically adds Textboxes & Labels depending on how many rows/Columns there are in the Sheet.
Now I have a problem, for example if I had "Steve" with number like 4, it would not show the exact number in the cell Instead it will show the Row number.
Excel Data Sheet Screenshot
So what I want is to fix the Number : Label and also make the TextBox for example now if i type 1 it will show the data for the Row number 1 i want to make it work with "Steve" writing a "4" instead of a "2" Which is the row number.
Here is the Userform code:
Private Sub CommandButton1_Click()
'Exit Form
Unload Me
End Sub
Private Sub CommandButton2_Click()
'Edit
k = ScrollBar1.Value
lcol = Sheet1.Range("DX2").End(xlToLeft).Column
For j = 1 To lcol
Sheet1.Cells(k + 1, j) = Me.Controls("textbox" & j)
Next j
End Sub
Private Sub CommandButton3_Click()
'Delete
k = ScrollBar1.Value
Sheet1.Cells(k + 1, 1).EntireRow.Delete
End Sub
Private Sub ScrollBar1_Change()
Dim Rng As Range
lcol = Sheet1.Range("DX2").End(xlToLeft).Column
k = ScrollBar1.Value
k2 = TextBox1000.Value
label1000.Caption = "Number : " & k
If k <> 0 And k2 <> 0 Then
TextBox1000.Value = k
For j = 1 To lcol
Me.Controls("textbox" & j).Text = Sheet1.Cells(k, j).Offset(1, 0).Value
Next j
End If
End Sub
Private Sub TextBox1000_Change()
lcol = Sheet1.Range("DX2").End(xlToLeft).Column
k = ScrollBar1.Value
k2 = TextBox1000.Value
label1000.Caption = "Number : " & k2
If k2 <> "" Then
ScrollBar1.Value = k2
For j = 1 To lcol
Me.Controls("textbox" & j).Text = Sheet1.Cells(k2, j).Offset(1, 0).Value
Next j
End If
End Sub
Private Sub UserForm_Initialize()
Dim myLabel As Control
Dim txtbox As Control
k = ScrollBar1.Value
label1000.Caption = "Number : " & k
lcol = Sheet1.Range("DX2").End(xlToLeft).Column
For i = 1 To lcol
Set myLabel = Frame1.Controls.Add("Forms.label.1", "label" & i, True)
myLabel.Left = 250
myLabel.Top = 12 + (i * 20)
myLabel.Width = 150
myLabel.Height = 15
Set txtbox = Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i, True)
txtbox.Left = 50
txtbox.Top = 10 + (i * 20)
txtbox.Width = 180
txtbox.Height = 60
Next i
For j = 1 To lcol
With Frame1.Controls("label" & j)'Formating Labels
.Caption = Sheet1.Cells(1, j).Value
.TextAlign = fmTextAlignCenter
.Font.Bold = True
.Font.Size = 11
.FontName = "Times New Roman"
.ForeColor = vbRed
End With
With Frame1.Controls("TextBox" & j) 'Formating TextBoxes
.Text = Sheet1.Cells(1, j).Offset(1, 0).Value
.TextAlign = fmTextAlignRight
.Font.Bold = True
.Font.Size = 11
.FontName = "Times New Roman"
End With
With Frame1.Controls("TextBox1")'Make textbox1 not editable
.Enabled = False
End With
With Frame1.Controls("TextBox3")'Make textbox3 not editable
.Enabled = False
End With
Next j
End Sub
I'd say
Label1000.Caption = "Number : " & Sheet1.Cells(k + 1, 1).Value
I have made a macro which creates some graphs in excel and then opens powerpoint and pastes them into a template. Over the past couple of weeks and it has been working completely fine but after adding some things into the macro (which are completely separate things like refreshing data and setting filters) it seems to be crashing when pasting the graphs into powerpoint. Anyone else had similar issues in the past? There doesn't seem to be any reason why it should be doing it at all...
Sub PowerpointPres(r)
Dim PPT As Object
Dim PPApp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim PPShape As Shape
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open filename:="S:\Commercial Finance\Macros for Standard Reporting\Country Manager Presentation Macro\CM Presentation Template.pptm"
Set PPApp = CreateObject("Powerpoint.Application")
Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
'Slide 1
Set PPSlide = PPPres.Slides(1)
PPSlide.Shapes(1).TextFrame.TextRange.Text = r & " Country Review YTD " & Year(Now())
'Slide 2
Set PPSlide = PPPres.Slides(2)
PPSlide.Shapes(1).TextFrame.TextRange.Text = r & " Country Review YTD " & Year(Now())
'Slide 3
Pivots.ChartObjects(1).Copy
i = Pivots.Range("G14").Text
j = Pivots.Range("H14").Text
Set PPSlide = PPPres.Slides(3)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " TCV YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Sector"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.ActiveWindow.View.GotoSlide (3)
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
'PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 55
.Left = 85
.Height = 350
.Width = 550
With .Chart.SeriesCollection(1).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(0, 94, 140)
.BackColor.RGB = RGB(0, 165, 241)
.GradientStops.Insert RGB(0, 138, 202), 0.5
End With
With .Chart.SeriesCollection(2).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(85, 85, 85)
.BackColor.RGB = RGB(125, 125, 125)
.GradientStops.Insert RGB(150, 150, 150), 0.5
End With
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 4
Pivots.ChartObjects(2).Copy
i = Pivots.Range("V14").Text
j = Pivots.Range("W14").Text
Set PPSlide = PPPres.Slides(4)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " TCV YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Type"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.ActiveWindow.View.GotoSlide (4)
'PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
With PPSlide.Shapes(3)
.Top = 55
.Left = 85
.Height = 350
.Width = 550
With .Chart.SeriesCollection(1).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(0, 94, 140)
.BackColor.RGB = RGB(0, 165, 241)
.GradientStops.Insert RGB(0, 138, 202), 0.5
End With
With .Chart.SeriesCollection(2).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(85, 85, 85)
.BackColor.RGB = RGB(125, 125, 125)
.GradientStops.Insert RGB(150, 150, 150), 0.5
End With
End With
'Slide 5
LRow = Pivots.Range("AH8").End(xlDown).Row
Pivots.Range("AH8:AI" & LRow).Copy
Set PPSlide = PPPres.Slides(5)
PPApp.ActiveWindow.View.GotoSlide (5)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 70
.Left = 50
.Height = 400
.Width = 200
End With
Pivots.ChartObjects(3).Copy
PPApp.ActiveWindow.View.GotoSlide (5)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New TCV by AM YTD " & Year(Now())
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 80
.Left = 300
.Height = 380
.Width = 350
End With
'Slide 6
LRow = Pivots.Range("AN8").End(xlDown).Row
Pivots.Rows("8:" & LRow).RowHeight = 20
Pivots.Range("AN8:AO" & LRow).Copy
Set PPSlide = PPPres.Slides(6)
PPApp.ActiveWindow.View.GotoSlide (6)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 70
.Left = 50
.Height = 380
.Width = 200
End With
Pivots.ChartObjects(4).Copy
PPApp.ActiveWindow.View.GotoSlide (6)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New TCV by Product YTD " & Year(Now())
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 80
.Left = 300
.Height = 380
.Width = 350
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 7
LRow = Pivots.Range("AY8").End(xlDown).Row
Pivots.Range("AT1:AZ" & LRow).Copy
Set PPSlide = PPPres.Slides(7)
PPApp.ActiveWindow.View.GotoSlide (7)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Top 10 TCV New Deals Signed YTD " & Year(Now())
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
'Slide 9
LRow = Pivots.Range("BG1").End(xlDown).Row
Pivots.Range("BD1:BG" & LRow).Copy
Set PPSlide = PPPres.Slides(9)
PPApp.ActiveWindow.View.GotoSlide (9)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " IR – Top 10 Customers YTD " & Year(Now())
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 10
Pivots.ChartObjects(11).Copy
i = Pivots.Range("CZ19").Text
j = Pivots.Range("DA19").Text
Set PPSlide = PPPres.Slides(10)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New IIR YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Sales Sector"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.ActiveWindow.View.GotoSlide (10)
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
'PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 55
.Left = 85
.Height = 350
.Width = 550
With .Chart.SeriesCollection(1).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(0, 94, 140)
.BackColor.RGB = RGB(0, 165, 241)
.GradientStops.Insert RGB(0, 138, 202), 0.5
End With
With .Chart.SeriesCollection(2).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(85, 85, 85)
.BackColor.RGB = RGB(125, 125, 125)
.GradientStops.Insert RGB(150, 150, 150), 0.5
End With
End With
'Slide 11
Pivots.ChartObjects(5).Copy
Set PPSlide = PPPres.Slides(11)
LRow = Pivots.Range("BK:BO").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
i = Pivots.Range("BL" & LRow).Text
j = Pivots.Range("BM" & LRow).Text
k = Pivots.Range("BN" & LRow).Text
l = Pivots.Range("BO" & LRow).Text
PPApp.ActiveWindow.View.GotoSlide (11)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Monthly Net MRC YTD " & Year(Now())
With .Shapes(2)
.TextFrame.TextRange.Text = "MRC Won " & Year(Now()) & " YTD: € " & i
.Top = 5
.Left = 475
.Height = 30
.Width = 250
End With
With .Shapes(3)
.TextFrame.TextRange.Text = "MRC Ceased " & Year(Now()) & " YTD: € " & j
.Top = 20
.Left = 475
.Height = 30
.Width = 250
End With
With .Shapes(4)
.TextFrame.TextRange.Text = "MRC Erosion " & Year(Now()) & " YTD: € " & k
.Top = 35
.Left = 475
.Height = 30
.Width = 250
End With
With .Shapes(5)
.TextFrame.TextRange.Text = "Net MRC " & Year(Now()) & " YTD: € " & l
.Top = 50
.Left = 475
.Height = 30
.Width = 250
End With
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(6)
.Top = 80
.Left = 30
.Height = 380
.Width = 650
With .Chart
.ChartStyle = 2
.SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(146, 208, 80)
.SeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
.SeriesCollection(3).Format.Fill.ForeColor.RGB = RGB(246, 139, 31)
.SeriesCollection(4).Format.Fill.ForeColor.RGB = RGB(51, 51, 255)
End With
End With
'Slide 12
LRow = Pivots.Range("BR1").End(xlDown).Row
Pivots.Range("BR1:BW" & LRow).Copy
Set PPSlide = PPPres.Slides(12)
PPApp.ActiveWindow.View.GotoSlide (12)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Net MRC - Top 10 Customer YTD " & Year(Now())
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 13
Pivots.ChartObjects(6).Copy
Set PPSlide = PPPres.Slides(13)
PPApp.ActiveWindow.View.GotoSlide (13)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Revenue at Risk – MRC up for renewal"
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 420
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 14
Pivots.ChartObjects(7).Copy
Set PPSlide = PPPres.Slides(14)
PPApp.ActiveWindow.View.GotoSlide (14)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Revenue at Risk – Top 10 MRC up for renewal " & Year(Now())
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 420
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 15
Pivots.ChartObjects(8).Copy
Set PPSlide = PPPres.Slides(15)
i = Year(DateSerial(Year(Now()), Month(Now()), Day(Now())))
j = Month(DateSerial(Year(Now()), Month(Now()), Day(Now())))
PPApp.ActiveWindow.View.GotoSlide (15)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " – Top 5 MRC expiring " & Left(MonthName(j), 3) & "-" & i
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 370
.Width = 650
.Chart.ChartStyle = 8
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 16
Pivots.ChartObjects(9).Copy
Set PPSlide = PPPres.Slides(16)
i = Year(DateSerial(Year(Now()), Month(Now()) + 1, Day(Now())))
j = Month(DateSerial(Year(Now()), Month(Now()) + 1, Day(Now())))
PPApp.ActiveWindow.View.GotoSlide (16)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " – Top 5 MRC expiring " & Left(MonthName(j), 3) & "-" & i
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 370
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 17
Pivots.ChartObjects(10).Copy
Set PPSlide = PPPres.Slides(17)
i = Year(DateSerial(Year(Now()), Month(Now()) + 2, Day(Now())))
j = Month(DateSerial(Year(Now()), Month(Now()) + 2, Day(Now())))
PPApp.ActiveWindow.View.GotoSlide (17)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " – Top 5 MRC expiring " & Left(MonthName(j), 3) & "-" & i
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 370
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 18
Pivots.Range("FJ1:FO11").Copy
Set PPSlide = PPPres.Slides(18)
PPApp.ActiveWindow.View.GotoSlide (18)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Text = r & ": SalesForce Pipeline & Top Deals"
.Left = 100
.Top = 10
.Height = 50
.Width = 650
End With
Pivots.Range("SalesForceTable2").Copy
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 130
.Left = 30
.Height = 320
.Width = 660
End With
With PPSlide.Shapes(3)
.Top = 70
.Left = 30
.Height = 50
.Width = 660
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 19
LRow = Pivots.Range("EC1").End(xlDown).Row
If LRow < 19 Then
Pivots.Range("EC1:EL" & LRow).Copy
Else
Pivots.Range("EC1:EL19").Copy
End If
Set PPSlide = PPPres.Slides(19)
PPApp.ActiveWindow.View.GotoSlide (19)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg1)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
'Slide 20
If LRow > 19 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 19 And LRow <= 37 Then
Pivots.Range("EC20:EL" & LRow).Copy
Else
Pivots.Range("EC20:EL37").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(20, PPLayout)
Set PPSlide = PPPres.Slides(20)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (20)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg2)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
Application.Wait (Now + TimeValue("00:00:05"))
'slide 21
If LRow > 37 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 37 And LRow <= 55 Then
Pivots.Range("EC38:EL" & LRow).Copy
Else
Pivots.Range("EC38:EL55").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(21, PPLayout)
Set PPSlide = PPPres.Slides(21)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (21)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg3)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
'Slide 22
If LRow > 55 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 55 And LRow <= 73 Then
Pivots.Range("EC56:EL" & LRow).Copy
Else
Pivots.Range("EC56:EL73").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(22, PPLayout)
Set PPSlide = PPPres.Slides(22)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (22)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg4)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
'slide 23
If LRow > 73 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 73 And LRow <= 91 Then
Pivots.Range("EC74:EL" & LRow).Copy
Else
Pivots.Range("EC74:EL91").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(23, PPLayout)
Set PPSlide = PPPres.Slides(23)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (23)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg5)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
ContinueHere:
PPApp.ActivePresentation.SaveAs "S:\Commercial Finance\Macros for Standard Reporting\Country Manager Presentation Macro\Outputs\" & r & "\" & Format(Now(), "dd-MM-yyyy") & ".pptm"
PPApp.ActivePresentation.Close
PPApp.Quit
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
I learned from you that the error it gives is Shapes.PasteSpecial : Invalid request. Clipboard is empty or contains data which may not be pasted here.
The problem is that clipboard is not ready for pasting immediately after calling copy operation, but it needs some time to load the data. Let's give it the time:
Add small module containing this code:
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If
Now insert the following delay between your copy and paste statements:
Dim i as Integer
For i = 1 To 6
DoEvents()
Sleep 500 'milliseconds
Next i
This should give copy operation enough time to populate the clipboard.
You can adjust constant "6" in the above loop if it is too high or too low.
I'm running into an unusual problem.
I have a set of procedures to add a bunch of controls on different pages
One to add the frames
Public Sub AddFramesNP(form, pagina, nrpag)
Set cControl = form!main.Pages(nrpag).Controls.Add("Forms.Frame.1", "io" & masina, True)
With cControl
.Caption = "IO"
.Width = 210
.Height = 360
.Top = 2
.Left = 5
End With
Set cControl = form!main.Pages(nrpag).Controls.Add("Forms.Frame.1", "nio" & masina, True)
With cControl
.Caption = "nIO"
.Width = 210
.Height = 360
.Top = 2
.Left = 220
End With
Set cControl = form!main.Pages(nrpag).Controls.Add("Forms.Frame.1", "desc" & masina, True)
With cControl
.Caption = "Descriere"
.Width = 210
.Height = 360
.Top = 2
.Left = 435
End With
End Sub
One to add the Labels
Public Sub AddLabsNP(form, pagina, replicare, den, den1, den2)
Dim k, l As Integer
If den = 1 Then
Set cControl = form.Controls("io" & masina).Add("Forms.Label.1", "lden1" & pagina, True)
With cControl
.Caption = den1
.Width = 40
.Height = 10
.Top = 5
.Left = 5
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.Label.1", "lden1nio" & pagina, True)
With cControl
.Caption = den1
.Width = 40
.Height = 10
.Top = 5
.Left = 5
End With
End If
If replicare = 1 Then
Set cControl = form.Controls("io" & masina).Add("Forms.Label.1", "lden2" & pagina, True)
With cControl
.Caption = den2
.Width = 40
.Height = 10
.Top = 165
.Left = 5
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.Label.1", "lden2nio" & pagina, True)
With cControl
.Caption = den2
.Width = 40
.Height = 10
.Top = 165
.Left = 5
End With
End If
Do While l < replicare + 1
Set cControl = form.Controls("io" & masina).Add("Forms.Label.1", "lreper" & l & pagina, True)
With cControl
.Caption = "Reper"
.Width = 35
.Height = 9
.Top = 25 + k
.Left = 5
End With
Set cControl = form.Controls("io" & masina).Add("Forms.Label.1", "lsn" & l & pagina, True)
With cControl
.Caption = "SN"
.Width = 35
.Height = 9
.Top = 25 + k
.Left = 70
End With
Set cControl = form.Controls("io" & masina).Add("Forms.Label.1", "lqt" & l & pagina, True)
With cControl
.Caption = "Qt"
.Width = 35
.Height = 9
.Top = 25 + k
.Left = 155
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.Label.1", "lrepernio" & l & pagina, True)
With cControl
.Caption = "Reper"
.Width = 35
.Height = 9
.Top = 25 + k
.Left = 5
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.Label.1", "lsnnio" & l & pagina, True)
With cControl
.Caption = "SN"
.Width = 35
.Height = 9
.Top = 25 + k
.Left = 70
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.Label.1", "lqtnio" & l & pagina, True)
With cControl
.Caption = "Qt"
.Width = 35
.Height = 9
.Top = 25 + k
.Left = 155
End With
k = k + 155
l = l + 1
Loop
End Sub
And one to add the ComboBoxes
Public Sub AddCboxsNP(form, pagina, replicare, nrcboxs)
Dim k, l As Integer
l = 1
Do While l < nrcboxs + 1
Set cControl = form.Controls("io" & masina).Add("Forms.ComboBox.1", "combo" & l & pagina, True)
With cControl
.Width = 60
.Height = 14
.Top = 40 + k
.Left = 5
End With
Set cControl = form.Controls("io" & masina).Add("Forms.TextBox.1", "sn" & l & pagina, True)
With cControl
.Width = 80
.Height = 28
.Top = 40 + k
.Left = 70
End With
Set cControl = form.Controls("io" & masina).Add("Forms.TextBox.1", "q" & l & pagina, True)
With cControl
.Width = 30
.Height = 14
.Top = 40 + k
.Left = 155
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.ComboBox.1", "combo" & l & "nio" & pagina, True)
With cControl
.Width = 60
.Height = 14
.Top = 40 + k
.Left = 5
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.TextBox.1", "sn" & l & "nio" & pagina, True)
With cControl
.Width = 80
.Height = 28
.Top = 40 + k
.Left = 70
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.TextBox.1", "q" & l & "nio" & pagina, True)
With cControl
.Width = 30
.Height = 14
.Top = 40 + k
.Left = 155
End With
If replicare = 2 Then
Set cControl = form.Controls("io" & masina).Add("Forms.ComboBox.1", "combo" & l & "2" & pagina, True)
With cControl
.Width = 60
.Height = 14
.Top = 200 + k
.Left = 5
End With
Set cControl = form.Controls("io" & masina).Add("Forms.TextBox.1", "sn" & l & "2" & pagina, True)
With cControl
.Width = 80
.Height = 28
.Top = 200 + k
.Left = 70
End With
Set cControl = form.Controls("io" & masina).Add("Forms.TextBox.1", "q" & l & "2" & pagina, True)
With cControl
.Width = 30
.Height = 14
.Top = 200 + k
.Left = 155
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.ComboBox.1", "combo" & l & "2nio" & pagina, True)
With cControl
.Width = 60
.Height = 14
.Top = 200 + k
.Left = 5
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.TextBox.1", "sn" & l & "2nio" & pagina, True)
With cControl
.Width = 80
.Height = 28
.Top = 200 + k
.Left = 70
End With
Set cControl = form.Controls("nio" & masina).Add("Forms.TextBox.1", "q" & l & "2nio" & pagina, True)
With cControl
.Width = 30
.Height = 14
.Top = 200 + k
.Left = 155
End With
End If
k = k + 35
l = l + 1
Loop
End Sub
The problem is that when I want to use them I don't know why but they don't work for page 3 (I use them for page 2 and they work fine). I have to use this ones just for these 2 pages (2 and 3). And I have another set of procedures for the pages that contain multipages that work fine for 3 pages.
I really don't see where's the problem. I tried to add components manually (through code) and it worked fine. Did I do something that makes this procedures to work just 1 time? I don't see what because are the same with other procedures that work multiple times!
Thanks a lot for your help!
I know it is an old thread but just the same... :)
I am taking the Frames Code as an example. Please use it as a sample for the rest :)
Also this example creates the frames in a MultiPage1.
Let me know if this helps :)
Option Explicit
Private Sub CommandButton1_Click()
AddFramesNP Me, 3, 2
End Sub
Public Sub AddFramesNP(form As UserForm, masina, nrpag)
Dim cControl As Object
With form
Set cControl = .MultiPage1.Pages(nrpag).Controls.Add("Forms.Frame.1", "io" & masina)
With cControl
.Caption = "IO"
.Width = 210: .Height = 360: .Top = 2
.Left = 5
End With
Set cControl = .MultiPage1.Pages(nrpag).Controls.Add("Forms.Frame.1", "nio" & masina)
With cControl
.Caption = "nIO"
.Width = 210: .Height = 360: .Top = 2
.Left = 220
End With
Set cControl = .MultiPage1.Pages(nrpag).Controls.Add("Forms.Frame.1", "desc" & masina)
With cControl
.Caption = "Descriere"
.Width = 210: .Height = 360: .Top = 2
.Left = 435
End With
End With
End Sub