Thema Datum  Von Nutzer Rating
Antwort
07.04.2017 15:57:52 The_Materialist
NotSolved
07.04.2017 16:22:13 BigBen
NotSolved
07.04.2017 16:25:12 The_Materialist
NotSolved
Blau KlassenModul Verfügbarkeit von Eigenschaften
 07.04.2017 16:32:12 Gast73585
NotSolved

Ansicht des Beitrags:
Von:
Gast73585		 Datum:
07.04.2017 16:32:12		 Views:
785		 Rating:
     
Antwort:
  Ja
Thema:
KlassenModul Verfügbarkeit von Eigenschaften

Hier die fertige Klasse: 

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
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:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
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!

Ihre Antwort
  • 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: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • 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
NotSolved
07.04.2017 16:22:13 BigBen
NotSolved
07.04.2017 16:25:12 The_Materialist
NotSolved
Blau KlassenModul Verfügbarkeit von Eigenschaften
 07.04.2017 16:32:12 Gast73585
NotSolved