Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
07.04.2017 15:57:52 |
The_Materialist |
|
|
|
07.04.2017 16:22:13 |
BigBen |
|
|
|
07.04.2017 16:25:12 |
The_Materialist |
|
|
KlassenModul Verfügbarkeit von Eigenschaften |
07.04.2017 16:32:12 |
Gast73585 |
|
|
Von:
Gast73585 |
Datum:
07.04.2017 16:32:12 |
Views:
612 |
Rating:
|
Antwort:
|
Thema:
KlassenModul Verfügbarkeit von Eigenschaften |
Hier die fertige Klasse:
Option Explicit
Public WithEvents Filter As MSForms.Combobox
Public WithEvents Operator As MSForms.Combobox
Public WithEvents Options As MSForms.Combobox
Public Index As Integer
Public Sub Add()
' set index
Me.Index = frmFilter.FilterCol.Count
' Move Buttons and increase userforms size
frmFilter.Height = frmFilter.Height + 50
frmFilter.AddFilter.Move Top:=frmFilter.AddFilter.Top + 50
frmFilter.Logo.Top = frmFilter.Logo.Top + 50
frmFilter.RemoveFilter.Top = frmFilter.RemoveFilter.Top + 50
frmFilter.Backbtn.Top = frmFilter.Backbtn.Top + 50
frmFilter.GO_btn.Top = frmFilter.GO_btn.Top + 50
' Add Filter, Operator and Options
' Filter
Set Me.Filter = frmFilter.Controls.Add("Forms.ComboBox.1", "Filter" & (Index), True)
With Me.Filter.Font
.name = "Arial"
.Size = 16
.Bold = True
End With
Me.Filter.Top = frmFilter.DefaultFilter.Top + 50 * (Index)
Me.Filter.Left = frmFilter.DefaultFilter.Left
Me.Filter.Width = frmFilter.DefaultFilter.Width
Me.Filter.Height = frmFilter.DefaultFilter.Height
'Operator
Set Me.Operator = frmFilter.Controls.Add("Forms.ComboBox.1", "Operator" & Index, True)
With Me.Operator.Font
.name = "Arial"
.Size = 16
.Bold = True
End With
Me.Operator.Top = frmFilter.DefaultOperator.Top + 50 * (Index)
Me.Operator.Left = frmFilter.DefaultOperator.Left
Me.Operator.Width = frmFilter.DefaultOperator.Width
Me.Operator.Height = frmFilter.DefaultOperator.Height
'Options
Set Me.Options = frmFilter.Controls.Add("Forms.ComboBox.1", "Options" & Index, True)
With Me.Options.Font
.name = "Arial"
.Size = 16
.Bold = True
End With
Me.Options.Top = frmFilter.DefaultOptions.Top + 50 * (Index)
Me.Options.Left = frmFilter.DefaultOptions.Left
Me.Options.Width = frmFilter.DefaultOptions.Width
Me.Options.Height = frmFilter.DefaultOptions.Height
Call fillOperator
Call fillOptions
Index = Index + 1
frmFilter.RemoveFilter.Enabled = True
End Sub
Public Sub Remove()
Index = Index - 1
frmFilter.Controls.Remove ("Filter" & Index)
frmFilter.Controls.Remove ("Options" & Index)
frmFilter.Controls.Remove ("Operator" & Index)
frmFilter.FilterCol.Remove (frmFilter.FilterCol.Count)
frmFilter.Height = frmFilter.Height - 50
frmFilter.Logo.Top = frmFilter.Logo.Top - 50
frmFilter.Backbtn.Top = frmFilter.Backbtn.Top - 50
frmFilter.GO_btn.Top = frmFilter.GO_btn.Top - 50
frmFilter.RemoveFilter.Top = frmFilter.RemoveFilter.Top - 50
frmFilter.AddFilter.Top = frmFilter.AddFilter.Top - 50
If Index = 1 Then
frmFilter.RemoveFilter.Enabled = False
End If
End Sub
Public Sub fillFilter()
Debug.Print "Here Filter: " & Me.Filter.name & " will be filled."
End Sub
Private Sub fillOperator()
Debug.Print "Here Operator: " & Me.Operator.name & " will be filled."
End Sub
Private Sub fillOptions()
Debug.Print "Here Options: " & Me.Options.name & " will be filled."
End Sub
Dazu die Userform:
Option Explicit
'This is written by Lucas Raphael Pianegonda @ EMS Chemie. Since the employment contract does not treat copyright, the copyright
'of this code is owned by Lucas Meier. The code can be used and modified by others in or outside the company. However any licencing,
'commerciallization of the code it self and not it's produced outputs can only occure with the explicit permission of Lucas Raphael Pianegonda.
'This userform is designed to allow the user to add as many filters to search a specific
Public SP As Boolean ' Singelpoint
Public MP As Boolean ' Multipoint
Public DS As Boolean ' Datasheets
Public SC As Boolean ' Scatterplots
Public FilterCol As Collection
Private N As Integer
Private Sub AddFilter_Click()
Dim Entry As FilterLine
Set Entry = New FilterLine
Entry.Add
FilterCol.Add Entry
End Sub
Private Sub GO_btn_Click()
Me.Hide
If Not (frmUI.MP Xor frmUI.SP Xor frmUI.DS Xor frmUI.SC) Then
GoTo Fehler
End If
If frmUI.MP Then
Multipoint.MultiPoint_plot
Me.Hide
ElseIf frmUI.SP Then
SinglePoint.SinglePoint_display
Me.Hide
ElseIf frmUI.DS Then
MsgBox "DataSheet was activated but data sheets have a defined selection of properties which they display. So this makes no sense here."
Me.Hide
ElseIf frmUI.SC Then
MsgBox "Scatterplot was activated, but this makes no sense here."
Me.Hide
End If
Exit Sub
Fehler:
MsgBox "There is not exactly one true trigger there is something wrong. Either all of them are False or more then one are True."
End Sub
Private Sub Backbtn_Click()
frmUI.MP = False
frmUI.SP = False
frmUI.DS = False
frmUI.SC = False
frmFilter.Hide
frmUI.Show
End Sub
Private Sub RemoveFilter_Click()
FilterCol.Item(FilterCol.Count).Remove
End Sub
Private Sub UserForm_Initialize()
Set FilterCol = New Collection
Dim DefaultFilterLine As FilterLine
Set DefaultFilterLine = New FilterLine
Set DefaultFilterLine.Filter = frmFilter.DefaultFilter
Set DefaultFilterLine.Operator = frmFilter.DefaultOperator
Set DefaultFilterLine.Options = frmFilter.DefaultOptions
DefaultFilterLine.Index = 0
DefaultFilterLine.fillFilter
FilterCol.Add DefaultFilterLine
End Sub
Grüsse und schönes Wochenende!
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
07.04.2017 15:57:52 |
The_Materialist |
|
|
|
07.04.2017 16:22:13 |
BigBen |
|
|
|
07.04.2017 16:25:12 |
The_Materialist |
|
|
KlassenModul Verfügbarkeit von Eigenschaften |
07.04.2017 16:32:12 |
Gast73585 |
|
|