I'm having troubles to assign a datasource to a code-generated c1report.
This is the datatable data.
This is the output result pdf view.
I'm using Visual Studio 2008 with ComponentOne 2009.
The result pdf file as not the correct data, only the titles repeated to bottom.
Then, this is the vb code:
Public Function DataTableToC1Report(ByVal dtDatos As DataTable, ByVal strTitulo As String) As C1.C1Report.C1Report
Dim c1r As New C1.C1Report.C1Report
'Inicia control
With c1r
'limpia fields existentes
.Clear()
'configura fuente para todos los controles
.Font.Name = "Tahoma"
.Font.Size = 8
End With
'Inicializar diseño
With c1r.Layout
.Orientation = C1.C1Report.OrientationEnum.Portrait
.Width = 6.5 * 1440 ' 8.5 - margen, en twips (aprox. son 567 twips por centímetro)
End With
'Crear encabezado y agregar field para titulo
Dim f As C1.C1Report.Field
With c1r.Sections(C1.C1Report.SectionTypeEnum.Header)
.Height = 1440
.Visible = True
.BackColor = Color.FromArgb(200, 200, 200)
f = .Fields.Add("FldTitle", strTitulo, 0, 0, 8000, 1440)
f.Font.Size = 24
f.Font.Bold = True
f.ForeColor = Color.FromArgb(0, 0, 100)
End With
'Crea footer de página
With c1r.Sections(C1.C1Report.SectionTypeEnum.PageFooter)
.Height = 500
.Visible = True
f = .Fields.Add("FldFtrLeft", """Generado el "" & Now", 0, 0, 4000, 300)
f.Calculated = True
f = .Fields.Add("FldFtrRight", """Página "" & Page & "" de "" & Pages", 4000, 0, 4000, 300)
f.Calculated = True
f.Align = C1.C1Report.FieldAlignEnum.RightTop
f.Width = c1r.Layout.Width - f.Left
f = .Fields.Add("FldLine", "", 0, 0, c1r.Layout.Width, 20)
f.LineSlant = C1.C1Report.LineSlantEnum.NoSlant
f.BorderStyle = C1.C1Report.BorderStyleEnum.Solid
f.BorderColor = Color.FromArgb(0, 0, 100)
End With
'Genera títulos con fields
With c1r.Sections(C1.C1Report.SectionTypeEnum.PageHeader)
.Height = 500
.Visible = True
Dim i As Integer = 0
Dim pIzq As Double = 0
Dim pArriba As Double = 50
Dim pAncho As Double = 800
Dim pAltura As Double = 300
For Each dc As DataColumn In dtDatos.Columns
c1r.Font.Bold = True
f = .Fields.Add("lblCol" & i.ToString, dc.ColumnName, pIzq, pArriba, pAncho, pAltura)
c1r.Font.Bold = False
f.Align = C1.C1Report.FieldAlignEnum.CenterMiddle
i += 1
pIzq += (pAncho + 100)
Next
f = .Fields.Add("FldLine", "", 0, 400, c1r.Layout.Width, 20)
f.LineSlant = C1.C1Report.LineSlantEnum.NoSlant
f.LineWidth = 50
f.BorderColor = Color.FromArgb(100, 100, 100)
End With
'Crea sección de detalle
With c1r.Sections(C1.C1Report.SectionTypeEnum.Detail)
Dim i As Integer = 0
Dim pIzq As Double = 0
Dim pArriba As Double = 0
Dim pAncho As Double = 800
Dim pAltura As Double = 300
.Height = 330
.Visible = True
For Each dc As DataColumn In dtDatos.Columns
c1r.Font.Bold = True
f = .Fields.Add("fldCol" & i.ToString, dc.ColumnName, pIzq, pArriba, pAncho, pAltura)
c1r.Font.Bold = False
f.Calculated = False 'agregar que permita verificar si la columna debe ser calculada y poner en True
f.CanGrow = False 'agregar que permita verificar si la columna puede crecer de tamaño
f.Align = C1.C1Report.FieldAlignEnum.CenterMiddle
'f.Width = c1r.Layout.Width - f.Left
f.Font.Size = 6
i += 1
pIzq += (pAncho + 100)
Next
f = .Fields.Add("FldLine", "", 0, 310, c1r.Layout.Width, 20)
f.LineSlant = C1.C1Report.LineSlantEnum.NoSlant
f.BorderStyle = C1.C1Report.BorderStyleEnum.Solid
f.BorderColor = Color.FromArgb(100, 100, 100)
End With
'Inicializar(DataSource)
With c1r.DataSource
'.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
' "Data Source=C:\...\ComponentOne Samples\Common\C1NWind.mdb;" & _
' "Persist Security Info=False"
'.RecordSource = "Employees"
.Recordset = dtDatos
End With
Return c1r
End Function
I think the issue is because you've set the Calculated property of the fields added in the Detail section to False. You need to set it to True in order to bind data to the fields.
Related
I have a Datagridview connected to a dataset.The problem is that occasionally,when the data is refreshed,it is not displayed in the DGV.The code is:
Private Sub DisplayInDGV()
Dim SQLSet As String
Dim DASet As New OleDb.OleDbDataAdapter
Dim DSSet As New DataSet
SQLSet = "Select * From SetDisplayTable"
DASet = New OleDb.OleDbDataAdapter(SQLSet, Con)
DSSet.Clear()
DASet.Fill(DSSet, "DSSetHere")
With DGVSetView
.Refresh()
.AutoGenerateColumns = False
.DataSource = Nothing
.DataSource = DSSet.Tables(0)
.Update()
DGVSetView.Columns(i).DataPropertyName = DSSet.Tables(0).Columns(i).ToString
.Columns(0).DataPropertyName = DSSet.Tables(0).Columns(0).ToString
.Columns(2).DataPropertyName = DSSet.Tables(0).Columns(1).ToString
.Columns(3).DataPropertyName = DSSet.Tables(0).Columns(2).ToString
.Columns(4).DataPropertyName = DSSet.Tables(0).Columns(3).ToString
.Columns(5).DataPropertyName = DSSet.Tables(0).Columns(4).ToString
.Columns(6).DataPropertyName = DSSet.Tables(0).Columns(5).ToString
.Columns(7).DataPropertyName = DSSet.Tables(0).Columns(6).ToString
.Columns(8).DataPropertyName = DSSet.Tables(0).Columns(7).ToString
.Columns(9).DataPropertyName = DSSet.Tables(0).Columns(8).ToString
.Columns(10).DataPropertyName = DSSet.Tables(0).Columns(9).ToString
.Columns(11).DataPropertyName = DSSet.Tables(0).Columns(10).ToString 'Item Unique Code for Hot Edit
.Columns(14).DataPropertyName = DSSet.Tables(0).Columns(12).ToString
End With
'Updating Totals/::
For ItemRow As Integer = 0 To DGVSetView.Rows.Count - 1
If DGVSetView.Rows(ItemRow).Cells(14).Value = True Then
DGVSetView.Rows(ItemRow).Cells(12).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
ElseIf DGVSetView.Rows(ItemRow).Cells(14).Value = False Then
DGVSetView.Rows(ItemRow).Cells(13).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
End If
Next
'Updating School and general totals in DGV//:
Dim SchoolTotal, GeneralTotal As Decimal
For ColumnTotal As Integer = 0 To DGVSetView.Rows.Count - 1
SchoolTotal += DGVSetView.Rows(ColumnTotal).Cells(12).Value
GeneralTotal += DGVSetView.Rows(ColumnTotal).Cells(13).Value
Next
txtSchoolAmtFinal.Text = SchoolTotal
txtGeneralAmtFinal.Text = GeneralTotal
DGVSetView.Update()
'Get gross total of the DGV amount column//:
If DGVSetView.RowCount <> 0 Then
Dim GrossAmt As Decimal = 0
For Index As Integer = 0 To DGVSetView.RowCount - 1
' GrossAmt += Convert.ToDecimal(DataGridView1.Rows(Index).Cells(11).Value)
If Str(DGVSetView.Rows(Index).Cells(10).Value) = "Null" Or (DGVSetView.Rows(Index).Cells(10).Value) <= 0 Then
MsgBox("Item Number " & (DGVSetView.Rows(Index).Cells(10).Value) & " is either blank or 0", MsgBoxStyle.Exclamation, "Item Error")
Else
GrossAmt += Convert.ToDecimal(DGVSetView.Rows(Index).Cells(10).Value)
End If
Next
txtInsertGrossAmt.Text = GrossAmt ' - Val(DGVSetView.Text)
Call SetNetAmount()
End If
'Generate Serial//:
Dim X As Integer
Do While X < DGVSetView.Rows.Count
DGVSetView.Item(0, X).Value = X + 1
X = X + 1
Loop
'Disbaling editing in all columns except pending//:
With DGVSetView
.Columns(0).ReadOnly = True
.Columns(2).ReadOnly = True
.Columns(3).ReadOnly = True
.Columns(4).ReadOnly = True
.Columns(5).ReadOnly = True
.Columns(6).ReadOnly = True
.Columns(7).ReadOnly = True
.Columns(8).ReadOnly = True
.Columns(9).ReadOnly = True
.Columns(10).ReadOnly = True
End With
txtTotalItems.Text = DGVSetView.Rows.Count
For Each r As DataGridViewRow In DGVSetView.Rows
r.Cells(1).Value = True
Next r
End Sub
The problem is that occasionally,the DGV will not show any rows and displays a blank frame.At such instances.if I check in DGV.Rows.count
the result is 0 despite there being underlying data in the table.
Note that this happens randomly.At other times the DGV refreshed properly and also displays data correctly.
Also note that this DGV resides within a TabControl.
Further,when the DGV fails to display the data,the totals which I have calculated in the above sub procedure return zero value.As such the problem appears to lie somewhere in the rows not being inserted in the DGV.
Thank you.
Khalid.
//Edit;Code Updated:
#jmcilhinney I have updated my code as follows.However,the earlier problem of the DGV going blank occasionally persists.Also the update process has slowed down slightly.It seems I may be making a mistake in the location of placing the Suspend and ResumeBinding statements:
Private Sub SetPreview()
Dim SQLSet As String
Dim DASet As New OleDb.OleDbDataAdapter
Dim DSSet As New DataSet
SQLSet = "Select * From SetDisplayTable"
Dim DTDGV As New DataTable
Dim DGVBindingSource As New BindingSource
DASet = New OleDb.OleDbDataAdapter(SQLSet, Con)
DASet.Fill(DTDGV)
DGVBindingSource.DataSource = DTDGV
DGVBindingSource.ResumeBinding()
With DGVSetView
.AutoGenerateColumns = False
.DataSource = DGVBindingSource
.Columns(0).DataPropertyName = DTDGV.Columns(0).ToString
.Columns(2).DataPropertyName = DTDGV.Columns(1).ToString
.Columns(3).DataPropertyName = DTDGV.Columns(2).ToString
.Columns(4).DataPropertyName = DTDGV.Columns(3).ToString
.Columns(5).DataPropertyName = DTDGV.Columns(4).ToString
.Columns(6).DataPropertyName = DTDGV.Columns(5).ToString
.Columns(7).DataPropertyName = DTDGV.Columns(6).ToString
.Columns(8).DataPropertyName = DTDGV.Columns(7).ToString
.Columns(9).DataPropertyName = DTDGV.Columns(8).ToString
.Columns(10).DataPropertyName = DTDGV.Columns(9).ToString
.Columns(11).DataPropertyName = DTDGV.Columns(10).ToString 'Item Unique Code for Hot Edit
.Columns(14).DataPropertyName = DTDGV.Columns(12).ToString
End With
DGVBindingSource.SuspendBinding()
'Updating Totals/::
For ItemRow As Integer = 0 To DGVSetView.Rows.Count - 1
If DGVSetView.Rows(ItemRow).Cells(14).Value = True Then
DGVSetView.Rows(ItemRow).Cells(12).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
ElseIf DGVSetView.Rows(ItemRow).Cells(14).Value = False Then
DGVSetView.Rows(ItemRow).Cells(13).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
End If
Next
'Updating School and general totals in DGV//:
Dim SchoolTotal, GeneralTotal As Decimal
For ColumnTotal As Integer = 0 To DGVSetView.Rows.Count - 1
SchoolTotal += DGVSetView.Rows(ColumnTotal).Cells(12).Value
GeneralTotal += DGVSetView.Rows(ColumnTotal).Cells(13).Value
Next
txtSchoolAmtFinal.Text = SchoolTotal
txtGeneralAmtFinal.Text = GeneralTotal
DGVSetView.Update()
'Get gross total of the DGV amount column//:
If DGVSetView.RowCount <> 0 Then
Dim GrossAmt As Decimal = 0
For Index As Integer = 0 To DGVSetView.RowCount - 1
' GrossAmt += Convert.ToDecimal(DataGridView1.Rows(Index).Cells(11).Value)
If Str(DGVSetView.Rows(Index).Cells(10).Value) = "Null" Or (DGVSetView.Rows(Index).Cells(10).Value) <= 0 Then
MsgBox("Item Number " & (DGVSetView.Rows(Index).Cells(10).Value) & " is either blank or 0", MsgBoxStyle.Exclamation, "Item Error")
Else
GrossAmt += Convert.ToDecimal(DGVSetView.Rows(Index).Cells(10).Value)
End If
Next
txtInsertGrossAmt.Text = GrossAmt ' - Val(DGVSetView.Text)
Call SetNetAmount()
End If
'Disabling editing in all columns except pending//:
With DGVSetView
.Columns(0).ReadOnly = True
.Columns(2).ReadOnly = True
.Columns(3).ReadOnly = True
.Columns(4).ReadOnly = True
.Columns(5).ReadOnly = True
.Columns(6).ReadOnly = True
.Columns(7).ReadOnly = True
.Columns(8).ReadOnly = True
.Columns(9).ReadOnly = True
.Columns(10).ReadOnly = True
End With
txtTotalItems.Text = DGVSetView.Rows.Count
For Each r As DataGridViewRow In DGVSetView.Rows
r.Cells(1).Value = True
Next r
End Sub
I am trying to insert an automated summary at the beginning of my PowerPoint presentation in VBA. (I am fairly new to Visual Basic)
I have found the code that gives me the references, but I can't seem to figure out the colour gradient of one shape.
With ActivePresentation.Slides(1)
.Shapes(1).Fill.Visible = msoTrue
.Shapes(1).Fill.ForeColor.RGB = RGB(208, 30, 60)
.Shapes(1).Fill.BackColor.RGB = RGB(97, 18, 30)
.Shapes(1).Fill.TwoColorGradient msoGradientHorizontal, 2
.Shapes(1).Line.Visible = msoFalse
The doc on the internet says the method is ForeColor and BackColor, but I can't seem to get it working. I don't understand why the second color is white and not dark red as its RGB code says.
my current template has the title on the side, and vertical, text towards the right side. The textbox is colored with a shading from RGB(208, 30, 60) to RGB(97, 18, 30) linearly with an angle of 270°.
this what is given by the complete VBA code (at the end)
This what I would like to have (with the numbers as shown in the VBA Slide)
Complete code:
Sub Sommaire()
Dim Diapo As Slide
Dim titre As Shape
Dim petit_titre As Shape
Dim texte_ajout As TextRange
Dim texte_sommaire As TextRange
Dim ligne_sommaire As TextRange
Dim y As Byte
'Si le titre de la première diapo est "Sommaire", elle sera supprimée
'cela permet de relancer la macro autant de fois que l'on souhaite
'sans avoir à supprimer la diapo de sommaire
If ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange = "SOMMAIRE" Then
ActivePresentation.Slides(1).Delete
End If
' ajoute une diapo en début de présentation avec
'la disposition de mise en titre n°2 du masque
ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutText
With ActivePresentation.Slides(1)
.Shapes(1).TextFrame.TextRange = "SOMMAIRE"
.Shapes(1).TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
.Shapes(1).TextFrame.TextRange.Font.Name = "Arial Black"
.Shapes(1).TextFrame.TextRange.Font.Size = 24
.Shapes(1).TextFrame2.TextRange.Font.Spacing = 3
.Shapes(1).TextFrame2.VerticalAnchor = msoAnchorBottom
.Shapes(1).TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignLeft
.Shapes(1).TextFrame2.MarginLeft = 14.1732283465
.Shapes(1).TextFrame2.MarginRight = 14.1732283465
.Shapes(1).TextFrame2.MarginTop = 14.1732283465
.Shapes(1).TextFrame2.MarginBottom = 28.3464566929
.Shapes(1).TextFrame2.WordWrap = msoTrue
.Shapes(1).TextFrame.Orientation = msoTextOrientationUpward
.Shapes(1).Left = 0 * 72
.Shapes(1).Top = 0 * 72
.Shapes(1).Height = ActivePresentation.PageSetup.SlideHeight
.Shapes(1).Width = 0.975 * 72
.Shapes(1).Fill.Visible = msoTrue
.Shapes(1).Fill.ForeColor.RGB = RGB(208, 30, 60)
.Shapes(1).Fill.BackColor.RGB = RGB(97, 18, 30)
.Shapes(1).Fill.TwoColorGradient msoGradientHorizontal, 2
.Shapes(1).Line.Visible = msoFalse
.Shapes(1).Shadow.Type = msoShadow25
.Shapes(1).Shadow.Visible = msoTrue
.Shapes(1).Shadow.Style = msoShadowStyleInnerShadow
.Shapes(1).Shadow.Blur = 5
.Shapes(1).Shadow.OffsetX = 3.9993907806
.Shapes(1).Shadow.OffsetY = -0.0698096257
.Shapes(1).Shadow.ForeColor.RGB = RGB(52, 9, 16)
.Shapes(1).Shadow.Transparency = 0.5
Set texte_ajout = .Shapes(2).TextFrame.TextRange
End With
With ActivePresentation.Slides(1).Shapes _
.AddShape(msoShapeRectangle, 1.5275 * 72, 32.7, 180, 29.1)
.TextFrame.TextRange.Text = "Sommaire"
.TextFrame.MarginBottom = 10
.TextFrame.MarginLeft = 10
.TextFrame.MarginRight = 10
.TextFrame.MarginTop = 10
.TextFrame.TextRange.Font.Name = "Arial Black"
.TextFrame.TextRange.Font.Size = 18
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignLeft
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
.TextFrame2.TextRange.Characters(1, 1).Font.Fill.ForeColor.RGB = RGB(208, 30, 60)
.TextFrame2.TextRange.Characters(2, 7).Font.Fill.ForeColor.RGB = RGB(39, 39, 39)
.Shadow.Visible = msoFalse
End With
'boucle sur toutes les diapos à partir de la 2e
For y = 2 To ActivePresentation.Slides.Count
Set Diapo = ActivePresentation.Slides(y)
'si la diapo a un titre
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
texte_ajout = texte_ajout & Format(y, "0 - ") & titre.TextFrame. _
TextRange.Text & Chr(13) & vbCrLf
End If
Next y
'ajout de liens aux items du sommaire
Set texte_sommaire = _
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange
texte_sommaire.Font.Size = 20
texte_sommaire.Font.Color.RGB = RGB(39, 39, 39)
With ActivePresentation.Slides(1).Shapes(2)
.Left = 1.5275 * 72
.Top = 1.9 * 72
End With
End Sub
Thank you in advance
I picked that from Excel macro recorder, as Shapes and most of the objects still have a lot of commons parts between Office applications.
ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
With Selection.ShapeRange
With .Fill
.ForeColor.RGB = RGB(255, 0, 0)
.BackColor.RGB = RGB(0, 0, 1)
.TwoColorGradient msoGradientHorizontal, 1
.RotateWithObject = msoTrue
.Visible = msoTrue
End With
With .TextFrame2.TextRange.Font
.BaselineOffset = 0
.Spacing = 1.6
End With
End With
You only need to "attach" (replace the Selection) it to your textbox, but I think you can handle that. I'll edit my answer to include all pointers I gave you in comments too.
I'm basically trying to display different sets of textboxes on a userform depending on the value taken by a combobox. I have created a class module called CControlEvents in which I describe the events that should occur when I change the value of the combobox :
Private WithEvents mclsCbx As MSForms.ComboBox
Private WithEvents UnitmclsTbx As MSForms.TextBox
Private WithEvents UnitmclsTbxLabel As MSForms.Label
Private WithEvents SpecMinMoymclsTbxLabel As MSForms.Label
Private WithEvents SpecMaxMoymclsTbxLabel As MSForms.Label
Private WithEvents SpecMinIndmclsTbxLabel As MSForms.Label
Private WithEvents SpecMaxIndmclsTbxLabel As MSForms.Label
Private WithEvents SpecMinMoymclsTbx As MSForms.TextBox
Private WithEvents SpecMaxMoymclsTbx As MSForms.TextBox
Private WithEvents SpecMinIndmclsTbx As MSForms.TextBox
Private WithEvents SpecMaxIndmclsTbx As MSForms.TextBox
Private WithEvents ListmclsTbxLabel As MSForms.Label
Private WithEvents ListmclsTbx As MSForms.TextBox
Private mMyProperty As Integer
Public Property Set Cbx(ByVal clsCbx As MSForms.ComboBox): Set mclsCbx = clsCbx: End Property
Public Property Get Cbx() As MSForms.ComboBox: Set Cbx = mclsCbx: End Property
'Property pour les textbox et labels
'TextBox d'unité
Public Property Set UnitTbx(ByVal clsTbx As MSForms.TextBox): Set UnitmclsTbx = clsTbx: End Property
Public Property Get UnitTbx() As MSForms.TextBox: Set UnitTbx = UnitmclsTbx: End Property
'Label d'unité
Public Property Set UnitTbxLabel(ByVal clsTbx As MSForms.Label): Set UnitmclsTbxLabel = clsTbx: End Property
Public Property Get UnitTbxLabel() As MSForms.Label: Set UnitTbxLabel = UnitmclsTbxLabel: End Property
'TextBox de spécification minimum moyenne
Public Property Set SpecMinMoyTbx(ByVal clsTbx As MSForms.TextBox): Set SpecMinMoymclsTbx = clsTbx: End Property
Public Property Get SpecMinMoyTbx() As MSForms.TextBox: Set SpecMinMoyTbx = SpecMinMoymclsTbx: End Property
'Label de spécification minimum moyenne
Public Property Set SpecMinMoyTbxLabel(ByVal clsTbx As MSForms.Label): Set SpecMinMoymclsTbxLabel = clsTbx: End Property
Public Property Get SpecMinMoyTbxLabel() As MSForms.Label: Set SpecMinMoyTbxLabel = SpecMinMoymclsTbxLabel: End Property
'Label de spécification maximum moyenne
Public Property Set SpecMaxMoyTbxLabel(ByVal clsTbx As MSForms.Label): Set SpecMaxMoymclsTbxLabel = clsTbx: End Property
Public Property Get SpecMaxMoyTbxLabel() As MSForms.Label: Set SpecMaxMoyTbxLabel = SpecMaxMoymclsTbxLabel: End Property
'TextBox de spécification max moy
Public Property Set SpecMaxMoyTbx(ByVal clsTbx As MSForms.TextBox): Set SpecMaxMoymclsTbx = clsTbx: End Property
Public Property Get SpecMaxMoyTbx() As MSForms.TextBox: Set SpecMaxMoyTbx = SpecMaxMoymclsTbx: End Property
'TextBox de spécification minimum individuelle
Public Property Set SpecMinIndTbx(ByVal clsTbx As MSForms.TextBox): Set SpecMinIndmclsTbx = clsTbx: End Property
Public Property Get SpecMinIndTbx() As MSForms.TextBox: Set SpecMinIndTbx = SpecMinIndmclsTbx: End Property
'Label de spécification minimum individuelle
Public Property Set SpecMinIndTbxLabel(ByVal clsTbx As MSForms.Label): Set SpecMinIndmclsTbxLabel = clsTbx: End Property
Public Property Get SpecMinIndTbxLabel() As MSForms.Label: Set SpecMinIndTbxLabel = SpecMinIndmclsTbxLabel: End Property
'Label de spécification maximum individuelle
Public Property Set SpecMaxIndTbxLabel(ByVal clsTbx As MSForms.Label): Set SpecMaxIndmclsTbxLabel = clsTbx: End Property
Public Property Get SpecMaxIndTbxLabel() As MSForms.Label: Set SpecMaxIndTbxLabel = SpecMaxIndmclsTbxLabel: End Property
'TextBox de spécification max individuelle
Public Property Set SpecMaxIndTbx(ByVal clsTbx As MSForms.TextBox): Set SpecMaxIndmclsTbx = clsTbx: End Property
Public Property Get SpecMaxIndTbx() As MSForms.TextBox: Set SpecMaxIndTbx = SpecMaxIndmclsTbx: End Property
'TextBox de liste déroulante
Public Property Set ListTbx(ByVal clsTbx As MSForms.TextBox): Set ListmclsTbx = clsTbx: End Property
Public Property Get ListTbx() As MSForms.TextBox: Set ListTbx = ListmclsTbx: End Property
'Label de liste déroulante
Public Property Set ListTbxLabel(ByVal clsTbx As MSForms.Label): Set ListmclsTbxLabel = clsTbx: End Property
Public Property Get ListTbxLabel() As MSForms.Label: Set ListTbxLabel = ListmclsTbxLabel: End Property
Public Property Get MyProperty() As Integer
MyProperty = mMyProperty
End Property
Public Property Let Transition(Value As Integer)
mMyProperty = Value
End Property
Private Sub mclsCbx_Change()
If (Me.Cbx.Text = "NUM") Then
UnitTbx.Visible = True
UnitmclsTbxLabel.Visible = True
SpecMinMoymclsTbxLabel.Visible = True
SpecMinMoymclsTbx.Visible = True
SpecMaxMoymclsTbx.Visible = True
SpecMaxMoymclsTbxLabel.Visible = True
SpecMinIndmclsTbxLabel.Visible = True
SpecMinIndmclsTbx.Visible = True
SpecMaxIndmclsTbx.Visible = True
SpecMaxIndmclsTbxLabel.Visible = True
ListmclsTbx.Visible = False
ListmclsTbxLabel.Visible = False
Else
If (Me.Cbx.Text = "LIST") Then
UnitTbx.Visible = False
UnitmclsTbxLabel.Visible = False
SpecMinMoymclsTbxLabel.Visible = False
SpecMinMoymclsTbx.Visible = False
SpecMaxMoymclsTbx.Visible = False
SpecMaxMoymclsTbxLabel.Visible = False
SpecMinIndmclsTbxLabel.Visible = False
SpecMinIndmclsTbx.Visible = False
SpecMaxIndmclsTbx.Visible = False
SpecMaxIndmclsTbxLabel.Visible = False
ListmclsTbx.Visible = True
ListmclsTbxLabel.Visible = True
End If
End If
End Sub
In the userform's code, I dynamically add such comboboxes :
Set gclsControlEvents = New CControlEvents
'On attribue la comboBox à une propriété de la classe créée
Set gclsControlEvents.Cbx = oleCbx
'On attribue une zone de texte à une propriété de la classe créée
Set gclsControlEvents.UnitTbx = numUnitTextBox
'Label unité
Set gclsControlEvents.UnitTbxLabel = UnitmclsTbxLabel
'Label spéc moy min
Set gclsControlEvents.SpecMinMoyTbxLabel = SpecMinMoyTbxLabel
'Zone de texte spéc moy min
Set gclsControlEvents.SpecMinMoyTbx = SpecMinMoymclsTbx
'Label spéc max min
Set gclsControlEvents.SpecMaxMoyTbxLabel = SpecMaxMoyTbxLabel
'Zone de texte spéc moy max
Set gclsControlEvents.SpecMaxMoyTbx = SpecMaxMoymclsTbx
So, I basically add the controls in the userform code and assign them to properties of the class, then I can simply hide/show as appropriate. The problem is that when I try to add several comboboxes based on this principle, using a for loop, it works only for the last comboboxe.
EDIT : The for loop
For i = 1 To NewSheetModelColumnsCount
Set Lbl = Frame1.Controls.Add("Forms.Label.1", "lbl1")
Set txtB1 = Frame1.Add("Forms.TextBox.1")
'Create the combobox
Set oleCbx = Frame1.Add("Forms.ComboBox.1") 'Bug at this line
With oleCbx
.name = "list" & i
.Height = 15
.Width = 100
.Left = 70
.Top = 10 * i * 3
.AddItem "NUM"
.AddItem "LIST"
End With
With txtB1
.name = "chkDemo" & i
.Height = 15
.Width = 100
.Left = 230
.Top = 10 * i * 3
End With
Lbl.Caption = "Colonne n°" + CStr(i)
Lbl.Top = txtB1.Top
Lbl.Left = 10
Set lbl2 = Frame1.Controls.Add("Forms.Label.1", "lbl2")
lbl2.Caption = "Intitulé : "
lbl2.Top = txtB1.Top
lbl2.Left = 180
lbl2.Visible = True
lbl2.Width = 50
Set UnitmclsTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "UnitmclsTbxLabel")
Set ListmclsTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "ListmclsTbxLabel")
Set SpecMinMoyTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "SpecMinMoyTbxLabel")
Set SpecMaxMoyTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "SpecMinMoyTbxLabel")
Set SpecMinIndTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "SpecMinIndTbxLabel")
Set SpecMaxIndTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "SpecMinIndTbxLabel")
UnitmclsTbxLabel.Caption = "Unité : "
UnitmclsTbxLabel.Left = 360
UnitmclsTbxLabel.Visible = False
Set numUnitTextBox = UserForm1.Frame1.Add("Forms.TextBox.1")
Set SpecMinMoymclsTbx = UserForm1.Frame1.Add("Forms.TextBox.1")
Set SpecMaxMoymclsTbx = UserForm1.Frame1.Add("Forms.TextBox.1")
Set SpecMinIndmclsTbx = UserForm1.Frame1.Add("Forms.TextBox.1")
Set SpecMaxIndmclsTbx = UserForm1.Frame1.Add("Forms.TextBox.1")
Set ListTextBox = UserForm1.Frame1.Add("Forms.TextBox.1")
SpecMinMoymclsTbx.Width = 50
SpecMaxMoymclsTbx.Width = 50
SpecMinIndmclsTbx.Width = 50
SpecMaxIndmclsTbx.Width = 50
With numUnitTextBox
.name = "Unit" & i
.Height = 15
.Width = 50
.Left = 360 + UnitmclsTbxLabel.Width - 40
.Top = 10 * i * 3
.Value = "Unit"
End With
ListTextBox.Top = numUnitTextBox.Top
ListTextBox.Left = numUnitTextBox.Left + numUnitTextBox.Width - 40
ListTextBox.Visible = False
ListTextBox.Width = 200
ListmclsTbxLabel.Caption = "Options : "
ListmclsTbxLabel.Visible = False
ListmclsTbxLabel.Top = numUnitTextBox.Top
ListmclsTbxLabel.Left = 360
UnitmclsTbxLabel.Top = numUnitTextBox.Top
SpecMinMoyTbxLabel.Top = numUnitTextBox.Top
SpecMinMoyTbxLabel.Left = numUnitTextBox.Left + numUnitTextBox.Width + 5
SpecMinMoyTbxLabel.Caption = "Spéc min Moy : "
SpecMinMoyTbxLabel.Visible = False
SpecMinMoymclsTbx.Top = numUnitTextBox.Top
SpecMinMoymclsTbx.Visible = False
SpecMinMoymclsTbx.Left = SpecMinMoyTbxLabel.Left + SpecMinMoyTbxLabel.Width - 15
SpecMaxMoyTbxLabel.Visible = False
SpecMaxMoyTbxLabel.Caption = "Spéc max moy : "
SpecMaxMoyTbxLabel.Left = SpecMinMoymclsTbx.Left + SpecMinMoymclsTbx.Width
SpecMaxMoyTbxLabel.Top = numUnitTextBox.Top
SpecMaxMoymclsTbx.Visible = False
SpecMaxMoymclsTbx.Top = numUnitTextBox.Top
SpecMaxMoymclsTbx.Left = SpecMaxMoyTbxLabel.Left + SpecMaxMoyTbxLabel.Width
SpecMinIndTbxLabel.Top = numUnitTextBox.Top
SpecMinIndTbxLabel.Left = SpecMaxMoymclsTbx.Left + SpecMaxMoymclsTbx.Width + 5
SpecMinIndTbxLabel.Caption = "Spéc min Ind : "
SpecMinIndTbxLabel.Visible = False
SpecMinIndmclsTbx.Top = numUnitTextBox.Top
SpecMinIndmclsTbx.Visible = False
SpecMinIndmclsTbx.Left = SpecMinIndTbxLabel.Left + SpecMinIndTbxLabel.Width - 15
SpecMaxIndTbxLabel.Visible = False
SpecMaxIndTbxLabel.Caption = "Spéc max moy : "
SpecMaxIndTbxLabel.Left = SpecMinIndmclsTbx.Left + SpecMinIndmclsTbx.Width
SpecMaxIndTbxLabel.Top = numUnitTextBox.Top
SpecMaxIndmclsTbx.Visible = False
SpecMaxIndmclsTbx.Top = numUnitTextBox.Top
SpecMaxIndmclsTbx.Left = SpecMaxIndTbxLabel.Left + SpecMaxIndTbxLabel.Width
numUnitTextBox.Visible = False
Set gclsControlEvents = New CControlEvents
'On attribue la comboBox à une propriété de la classe créée
Set gclsControlEvents.Cbx = oleCbx
'On attribue une zone de texte à une propriété de la classe créée
Set gclsControlEvents.UnitTbx = numUnitTextBox
'Label unité
Set gclsControlEvents.UnitTbxLabel = UnitmclsTbxLabel
'Label spéc moy min
Set gclsControlEvents.SpecMinMoyTbxLabel = SpecMinMoyTbxLabel
'Zone de texte spéc moy min
Set gclsControlEvents.SpecMinMoyTbx = SpecMinMoymclsTbx
'Label spéc max min
Set gclsControlEvents.SpecMaxMoyTbxLabel = SpecMaxMoyTbxLabel
'Zone de texte spéc moy max
Set gclsControlEvents.SpecMaxMoyTbx = SpecMaxMoymclsTbx
'Label spéc moy min
Set gclsControlEvents.SpecMinIndTbxLabel = SpecMinIndTbxLabel
'Zone de texte spéc moy min
Set gclsControlEvents.SpecMinIndTbx = SpecMinIndmclsTbx
'Label spéc max min
Set gclsControlEvents.SpecMaxIndTbxLabel = SpecMaxIndTbxLabel
'Zone de texte spéc moy max
Set gclsControlEvents.SpecMaxIndTbx = SpecMaxIndmclsTbx
'Zone de texte des options de la liste déroulante
Set gclsControlEvents.ListTbx = ListTextBox
'Label Options liste déroulante
Set gclsControlEvents.ListTbxLabel = ListmclsTbxLabel
Let gclsControlEvents.Transition = i
Next i
EDIT :
I tried to solve the problem by creating a variant array of as many instances of the class CControlEvents as I need comboboxes then using the element of this array at index i-1 at each iteration, but it didn't work, here is the code :
If (NewSheetModelColumnsCount > 0) Then
For i = 1 To 6
Controls("headerTextBox" + CStr(i)).Visible = True
Controls("CheckBox" + CStr(i)).Visible = True
Next i
For i = 11 To 16
Controls("label" + CStr(i)).Visible = True
Next i
Me.indicationLabel.Visible = False
'Name of the frame
With Me.Frame1
'This will create a vertical scrollbar
.ScrollBars = fmScrollBarsVertical
'Change the values of 2 as Per your requirements
.ScrollHeight = 30 * NewSheetModelColumnsCount + 50
.ScrollWidth = 30 * 50 + 50
'
End With
'Tentative
Dim classList As Variant
ReDim classList(0 To NewSheetModelColumnsCount - 1)
For i = 0 To NewSheetModelColumnsCount - 1
Set classList(i) = New CControlEvents
Next i
For i = 1 To NewSheetModelColumnsCount
Set Lbl = Frame1.Controls.Add("Forms.Label.1", "lbl1")
Set txtB1 = Frame1.Add("Forms.TextBox.1")
' Set ListBoxB1 = Frame1.Controls.Add("Forms.ComboBox.1")
' With ListBoxB1
' .Name = "list" & i
' .Height = 15
' .Width = 100
' .Left = 70
' .Top = 10 * i * 3
' .AddItem "NUM"
' .AddItem "LIST"
' End With
'Create the combobox
Set oleCbx = Frame1.Add("Forms.ComboBox.1") 'Bug at this line
With oleCbx
.name = "list" & i
.Height = 15
.Width = 100
.Left = 70
.Top = 10 * i * 3
.AddItem "NUM"
.AddItem "LIST"
End With
With txtB1
.name = "chkDemo" & i
.Height = 15
.Width = 100
.Left = 230
.Top = 10 * i * 3
End With
Lbl.Caption = "Colonne n°" + CStr(i)
Lbl.Top = txtB1.Top
Lbl.Left = 10
Set lbl2 = Frame1.Controls.Add("Forms.Label.1", "lbl2")
'Set txtB2 = Frame1.Add("Forms.TextBox.1")
' With txtB2
' .name = "unitTextBox" & i
' .Height = 15
' .Width = 100
' .Left = 240
' .Top = 10 * i * 3
' .Value = "txtB2"
' End With
lbl2.Caption = "Intitulé : "
lbl2.Top = txtB1.Top
lbl2.Left = 180
lbl2.Visible = True
lbl2.Width = 50
Set UnitmclsTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "UnitmclsTbxLabel")
Set ListmclsTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "ListmclsTbxLabel")
Set SpecMinMoyTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "SpecMinMoyTbxLabel")
Set SpecMaxMoyTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "SpecMinMoyTbxLabel")
Set SpecMinIndTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "SpecMinIndTbxLabel")
Set SpecMaxIndTbxLabel = UserForm1.Frame1.Controls.Add("Forms.Label.1", "SpecMinIndTbxLabel")
UnitmclsTbxLabel.Caption = "Unité : "
UnitmclsTbxLabel.Left = 360
UnitmclsTbxLabel.Visible = False
Set numUnitTextBox = UserForm1.Frame1.Add("Forms.TextBox.1")
Set SpecMinMoymclsTbx = UserForm1.Frame1.Add("Forms.TextBox.1")
Set SpecMaxMoymclsTbx = UserForm1.Frame1.Add("Forms.TextBox.1")
Set SpecMinIndmclsTbx = UserForm1.Frame1.Add("Forms.TextBox.1")
Set SpecMaxIndmclsTbx = UserForm1.Frame1.Add("Forms.TextBox.1")
Set ListTextBox = UserForm1.Frame1.Add("Forms.TextBox.1")
SpecMinMoymclsTbx.Width = 50
SpecMaxMoymclsTbx.Width = 50
SpecMinIndmclsTbx.Width = 50
SpecMaxIndmclsTbx.Width = 50
With numUnitTextBox
.name = "Unit" & i
.Height = 15
.Width = 50
.Left = 360 + UnitmclsTbxLabel.Width - 40
.Top = 10 * i * 3
.Value = "Unit"
End With
ListTextBox.Top = numUnitTextBox.Top
ListTextBox.Left = numUnitTextBox.Left + numUnitTextBox.Width - 40
ListTextBox.Visible = False
ListTextBox.Width = 200
ListmclsTbxLabel.Caption = "Options : "
ListmclsTbxLabel.Visible = False
ListmclsTbxLabel.Top = numUnitTextBox.Top
ListmclsTbxLabel.Left = 360
UnitmclsTbxLabel.Top = numUnitTextBox.Top
SpecMinMoyTbxLabel.Top = numUnitTextBox.Top
SpecMinMoyTbxLabel.Left = numUnitTextBox.Left + numUnitTextBox.Width + 5
SpecMinMoyTbxLabel.Caption = "Spéc min Moy : "
SpecMinMoyTbxLabel.Visible = False
SpecMinMoymclsTbx.Top = numUnitTextBox.Top
SpecMinMoymclsTbx.Visible = False
SpecMinMoymclsTbx.Left = SpecMinMoyTbxLabel.Left + SpecMinMoyTbxLabel.Width - 15
SpecMaxMoyTbxLabel.Visible = False
SpecMaxMoyTbxLabel.Caption = "Spéc max moy : "
SpecMaxMoyTbxLabel.Left = SpecMinMoymclsTbx.Left + SpecMinMoymclsTbx.Width
SpecMaxMoyTbxLabel.Top = numUnitTextBox.Top
SpecMaxMoymclsTbx.Visible = False
SpecMaxMoymclsTbx.Top = numUnitTextBox.Top
SpecMaxMoymclsTbx.Left = SpecMaxMoyTbxLabel.Left + SpecMaxMoyTbxLabel.Width
SpecMinIndTbxLabel.Top = numUnitTextBox.Top
SpecMinIndTbxLabel.Left = SpecMaxMoymclsTbx.Left + SpecMaxMoymclsTbx.Width + 5
SpecMinIndTbxLabel.Caption = "Spéc min Ind : "
SpecMinIndTbxLabel.Visible = False
SpecMinIndmclsTbx.Top = numUnitTextBox.Top
SpecMinIndmclsTbx.Visible = False
SpecMinIndmclsTbx.Left = SpecMinIndTbxLabel.Left + SpecMinIndTbxLabel.Width - 15
SpecMaxIndTbxLabel.Visible = False
SpecMaxIndTbxLabel.Caption = "Spéc max moy : "
SpecMaxIndTbxLabel.Left = SpecMinIndmclsTbx.Left + SpecMinIndmclsTbx.Width
SpecMaxIndTbxLabel.Top = numUnitTextBox.Top
SpecMaxIndmclsTbx.Visible = False
SpecMaxIndmclsTbx.Top = numUnitTextBox.Top
SpecMaxIndmclsTbx.Left = SpecMaxIndTbxLabel.Left + SpecMaxIndTbxLabel.Width
numUnitTextBox.Visible = False
'Set gclsControlEvents = New CControlEvents
'On attribue la comboBox à une propriété de la classe créée
Set classList(i - 1).Cbx = oleCbx
'On attribue une zone de texte à une propriété de la classe créée
Set classList(i - 1).UnitTbx = numUnitTextBox
'Label unité
Set classList(i - 1).UnitTbxLabel = UnitmclsTbxLabel
'Label spéc moy min
Set classList(i - 1).SpecMinMoyTbxLabel = SpecMinMoyTbxLabel
'Zone de texte spéc moy min
Set classList(i - 1).SpecMinMoyTbx = SpecMinMoymclsTbx
'Label spéc max min
Set classList(i - 1).SpecMaxMoyTbxLabel = SpecMaxMoyTbxLabel
'Zone de texte spéc moy max
Set classList(i - 1).SpecMaxMoyTbx = SpecMaxMoymclsTbx
'Label spéc moy min
Set classList(i - 1).SpecMinIndTbxLabel = SpecMinIndTbxLabel
'Zone de texte spéc moy min
Set classList(i - 1).SpecMinIndTbx = SpecMinIndmclsTbx
'Label spéc max min
Set classList(i - 1).SpecMaxIndTbxLabel = SpecMaxIndTbxLabel
'Zone de texte spéc moy max
Set classList(i - 1).SpecMaxIndTbx = SpecMaxIndmclsTbx
'Zone de texte des options de la liste déroulante
Set classList(i - 1).ListTbx = ListTextBox
'Label Options liste déroulante
Set classList(i - 1).ListTbxLabel = ListmclsTbxLabel
Let classList(i - 1).Transition = i
' Set Lbl3 = Frame1.Controls.Add("Forms.Label.1", "lbl3")
' Set txtB3 = Frame1.Add("Forms.TextBox.1")
' With txtB3
' .Name = "specMin" & i
' .Height = 15
' .Width = 200
' .Left = 410
' .Top = 10 * i * 3
' End With
' Lbl3.Caption = "Eléments : "
' Lbl3.Top = txtB3.Top
' Lbl3.Left = 360
Next i
'
'On modifie la visibilité des éléments pour ne permettre que la saisie du modèle courant
Me.RedefineModelParamButton.Visible = True
'
Me.Label1.Visible = False
Me.Label2.Visible = False
Me.Label3.Visible = False
Me.Label21.Visible = False
Me.NewSheetModelLabelTextBox.Visible = False
Me.NewSheetModelColumnsNumberTextBox.Visible = False
Me.SheetCategoryComboBox.Visible = False
Me.EnterNewSheetModelColumnsCountValidateButton.Visible = False
Me.EnterNewSheetModelColumnsCountCancelButton.Visible = False
Me.fcmIndexComboBox1.Visible = False
Me.fcmIndexComboBox2.Visible = False
End If
In the User-Form declare a VBA-Collection and store the instances of your class which wraps Combo-Boxes in this collection. In your class declare a Combo-Box variable WithEvents so you can handle events of the Combo-Box. HTH.
User Form
Private m_combos As New Collection
Private Sub UserForm_Initialize()
Set m_combos = New Collection
Dim i
Dim newCombo As CControlEvents
For i = 0 To 2
Set newCombo = New CControlEvents
With newCombo
Set .Combo = Me.Frame1.Add("Forms.ComboBox.1")
.Combo.Top = 20 * i
.Combo.AddItem "A"
.Combo.AddItem "B"
.Combo.AddItem "C"
End With
m_combos.Add newCombo
Next
End Sub
CControlEvents
Private WithEvents m_combo As MSForms.ComboBox
Private Sub m_combo_Change()
MsgBox "Change: " & Me.Combo.Name
End Sub
Public Property Get Combo() As MSForms.ComboBox
Set Combo = m_combo
End Property
Public Property Set Combo(ByVal newCombo As MSForms.ComboBox)
Set m_combo = newCombo
End Property
i have a little problem and actually i can't get out from his.. I have a column called 'Periodicidade' that gives me how many times must a thing get done.
What i want to do is a validation that it will count how many times exists one of them, and if one of them have the radiobutton fill, it will force the user to fill the others of the same type of periocidade, but in the moment he is counting the total gridview rows, and not the type of same periodicidade. My current code is:
Dim todos_items_periocidade_vazios As Boolean = True
Dim todos_items_periocidade_preenchidos As Boolean = False
Dim periocidade_validada As Boolean = False
'quantas linhas tem a grid
Dim n_linha_grid As Integer = GridView_Manutencao.Rows.Count
Dim periocidade_linha As String
Dim contador_preenchido As Integer = 0
Dim contador_linhas As Integer = 0
'para cada linha verificar
For Each row2 As GridViewRow In GridView_Manutencao.Rows
'percorrer tabela e validar a periocidade da linha encontrada
periocidade_linha = (CType(row2.FindControl("Label_Periodicidade"), Label).Text)
For Each row As GridViewRow In GridView_Manutencao.Rows
If ((CType(row.FindControl("Label_Periodicidade"), Label).Text) = periocidade_linha) Then
contador_linhas = contador_linhas + 1
periocidade_validada = True
If periocidade_validada = True Then
'testar se está vazio ou preenchido
If (CType(row.FindControl("RBList"), RadioButtonList).SelectedValue = "") Then
'percorrer a tabela e verificar se todos os itens estão vazios ou não
For Each row1 As GridViewRow In GridView_Manutencao.Rows
If ((CType(row1.FindControl("Label_Periodicidade"), Label).Text) = periocidade_linha) Then
If (CType(row1.FindControl("RBList"), RadioButtonList).SelectedValue = "") Then
todos_items_periocidade_vazios = True
Else
todos_items_periocidade_vazios = False
End If
End If
Next
Else
For Each row1 As GridViewRow In GridView_Manutencao.Rows
If ((CType(row1.FindControl("Label_Periodicidade"), Label).Text) = periocidade_linha) Then
If (CType(row1.FindControl("RBList"), RadioButtonList).SelectedValue <> "") Then
contador_preenchido = contador_preenchido + 1
todos_items_periocidade_preenchidos = True
Else
todos_items_periocidade_preenchidos = False
End If
End If
Next
End If
End If
End If
Next
valida_comentario()
If contador_preenchido = 0 Then
periocidade_validada = False
tudo_validado = False
ElseIf contador_preenchido < contador_linhas Then
periocidade_validada = False
tudo_validado = False
Else
If valida_comentario() = True Then
If ((todos_items_periocidade_vazios = True) And (todos_items_periocidade_preenchidos = True)) Then
periocidade_validada = True
tudo_validado = True
Lbl_Mensagem.Text = "Registo inserido com sucesso!"
ElseIf ((todos_items_periocidade_vazios = False) And (todos_items_periocidade_preenchidos = True)) Then
periocidade_validada = True
tudo_validado = True
Lbl_Mensagem.Text = "Registo inserido com sucesso!"
Else
periocidade_validada = False
tudo_validado = False
Lbl_Mensagem.Text = "Erro"
End If
Else
tudo_validado = False
periocidade_validada = False
Lbl_Mensagem.Text = "Erro"
End If
End If
Next
Return periocidade_validada
I got the answer, hope to be useful to all of you, thanks, here it goes:
Dim texto_periodicidade As String
Dim valor As String
Dim flag_validacao As Boolean = False
Dim contador_falso As Integer
contador_falso = 0
For Each linha As GridViewRow In GridView_Manutencao.Rows
texto_periodicidade = CType(linha.FindControl("Label_Periodicidade"), Label).Text
valor = CType(linha.FindControl("RBList"), RadioButtonList).SelectedValue
For Each row As GridViewRow In GridView_Manutencao.Rows
If (texto_periodicidade = CType(row.FindControl("Label_Periodicidade"), Label).Text) Then
If (valor = CType(row.FindControl("RBList"), RadioButtonList).SelectedValue) Then
flag_validacao = True
Else
contador_falso = contador_falso + 1
flag_validacao = False
End If
End If
Next row
Next linha
If contador_falso > 0 Then
Lbl_Mensagem.Text = "Complete os restantes valores da periocidade!"
contador_falso = 0
Return False
Else
If valida_comentario() = True Then
contador_falso = 0
Return True
End If
End If
I am using the ZedGraph control (zgc) to create individual stacked bar charts and display them in a single stacked column as shown in the image below.
The issue that I am having is that I have no control over the number of panes that are displayed in the control as this is determined by the number of items in a listbox. It seems that the default nature of the control allows the height of the graph panes to change depending on the number of panes that are displayed within the control.
The zgc is set to dock=fill within a panel control that is set to dock=fill within the form. I would like to force the graph panes to be a static height and when needed have a vertical scroll bar appear in the panel when the number of graph panes exceeds the height of the form. How can I go about achieving this? My code for creating and populating the zgc is posted below the image.
Private Sub CreateGraph(ByVal dat As Date)
Dim count As Integer = 0
Dim master As MasterPane = zgc.MasterPane
master.Fill = New Fill(Color.FromArgb(180, 180, 180), Color.FromArgb(180, 180, 180), 45.0F)
master.PaneList.Clear()
master.Title.IsVisible = True
master.Title.Text = "Workload for " & dat.ToShortDateString()
master.Margin.All = 10
master.InnerPaneGap = 5
master.IsCommonScaleFactor = False
For Each mach As String In lbMach.Items
rowCount = 0
Dim myPaneT As New GraphPane(New Rectangle(10, 10, 10, 10), "", "Time in Minutes", mach)
myPaneT.Fill.IsVisible = False
myPaneT.Chart.Fill = New Fill(Color.White, Color.White, 45.0F)
myPaneT.BaseDimension = 3.0F
myPaneT.XAxis.Title.IsVisible = False
myPaneT.XAxis.Scale.IsVisible = False
myPaneT.XAxis.Scale.Min = 0
myPaneT.XAxis.Scale.Max = (MeiSettings.WrkHrs * 60)
myPaneT.Legend.IsVisible = True
myPaneT.Border.IsVisible = False
myPaneT.Title.IsVisible = False
myPaneT.XAxis.MajorTic.IsOutside = False
myPaneT.XAxis.MinorTic.IsOutside = False
myPaneT.XAxis.MajorGrid.IsVisible = True
myPaneT.XAxis.MinorGrid.IsVisible = True
myPaneT.Margin.All = 1
If count = lbMach.Items.Count - 1 Then
myPaneT.XAxis.Title.IsVisible = True
myPaneT.XAxis.Scale.IsVisible = True
myPaneT.Margin.Bottom = 10
End If
If count > 0 Then
myPaneT.YAxis.Scale.IsSkipLastLabel = True
End If
myPaneT.YAxis.MinSpace = 20
myPaneT.Y2Axis.MinSpace = 20
Dim dt As DataTable = ItemsByMachineDT(mach, dat)
Dim myCurve As BarItem
If dt.Rows.Count > 0 Then
Dim profName As String = Nothing
Dim timeDur() As Double
For Each dr As DataRow In dt.Rows
If profName = dr("PRO").ToString() Then
timeDur = {((Convert.ToDouble(dr("QTY")) / Convert.ToDouble(dr("MPM"))))}
Else
timeDur = {((Convert.ToDouble(dr("QTY")) / Convert.ToDouble(dr("MPM")) + Convert.ToDouble(dr("Time"))))}
End If
myCurve = myPaneT.AddBar(dr("JOB").ToString & " - " & dr("PRO").ToString(), timeDur, Nothing, BarColor(rowCount))
If MeiSettings.IsGradient = True Then
myCurve.Bar.Fill = New Fill(BarColor(rowCount), Color.White, BarColor(rowCount), 90.0F)
Else
myCurve.Bar.Fill = New Fill(BarColor(rowCount), BarColor(rowCount), BarColor(rowCount), 90.0F)
End If
rowCount += 1
profName = dr("PRO").ToString()
Next
End If
myPaneT.YAxis.MajorTic.IsBetweenLabels = True
myPaneT.YAxis.Type = AxisType.Text
myPaneT.BarSettings.Type = BarType.Stack
myPaneT.BarSettings.Base = BarBase.Y
master.Add(myPaneT)
count += 1
Next
zgc.IsShowPointValues = True
Using g As Graphics = Me.CreateGraphics()
master.SetLayout(g, PaneLayout.SingleColumn)
master.AxisChange(g)
End Using
End Sub
to get control for each GraphPane :
GraphPane temp = zgc.MasterPane.PaneList.ElementAt(ind); //ind => index of the graphpane in zedgraphcontrol
to set static height n width ZedgraphControl :
zgc.Size = new Size(Width,Height);
to set visibility of scrollbar ZedgraphControl :
zgc.IsShowHScrollBar = true;
zgc.IsShowVScrollBar = true;