Das soll jetzt nur noch der gesamte Code sein für die Search Option ? Die hat ja eigentlich funktionietr mir geht nur um die Option Buttons, welche ich allerdings jetzt auch fertig habe :D man lernt wirklich nicht aus, thank Google :P
Mein aktueler Code:
'------------------------------------------'
'- Aufruf Tabelle Backend von Communities -'
'------------------------------------------'
Private Sub cmd_backend_tab1_Click()
Sheets("Backend").Select
End Sub
'-------------------------------------------'
'- Aufruf Tabelle Personal von Communities -'
'-------------------------------------------'
Private Sub cmd_personal_tab1_Click()
Sheets("Personal").Select
End Sub
'---------------------------------------------'
'- Aufruf Tabelle Verwaltung von Communities -'
'---------------------------------------------'
Private Sub cmd_verwaltung_tab1_Click()
Sheets("Verwaltung").Select
End Sub
Sub search_Change()
Dim strWert As String
Dim strSuche As String ' Danach wird gesucht
Dim rngFound As Range ' hier wurde es gefunden
Dim rngFound1 As Range
Dim strFirstAddress As String ' die Adresse der 1. Fundstelle
Dim strNextAddress As String ' die Adresse der nächsten Fundstelle
'Dim strFirstAddress1 As String ' die Adresse der 1. Fundstelle
'Dim strNextAddress1 As String ' die Adresse der nächsten Fundstelle
Dim zeile As Variant
Dim wzeile As Variant
Dim i As Integer 'Anzahl der Datensätze in Tabelle "Fxxxx"
strWert = Tabelle1.search
strWert = Replace(strWert, " ", "") 'ggf. Leerzeichen entfernen
strSuche = strWert
' After ans Ende stellen, damit die 1. Zelle von oben auch sicher gefunden wird
' Suchen in Spalte E (=5) in Werten, gesamten Zellinhalt vergleichen
Set rngFound = Columns(4).Find(What:=strSuche, After:=Cells(Rows.Count, 4), LookIn:=xlValues, LookAt:=xlWhole)
'Wenn Eingabe nicht vorhanden...
If rngFound Is Nothing Then
Exit Sub
End If
If Tabelle1.search <> "" Then
'Eingabe vorhanden...
' 1. Fundstelle merken fürs Abbrechen merken um FindNext abzubrechen
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(0, 154, 205)
Cells(wzeile(2), "AA") = "."
'Cells(wzeile(2), "S") = frmMain.txtName
'Cells(wzeile(2), "T") = frmMain.lblDatum
'Weitersuchen
Set rngFound = Columns(4).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(0, 154, 205)
Loop While rngFound.Address <> strFirstAddress
End If
'Tabelle1.lblStatus = "gefunden"
'------------------------------------
If Tabelle1.search = "" Then
Set rngFound = Columns("AA").Find(What:=".", After:=Cells(Rows.Count, "AA"), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Cells(wzeile(2), "AA") = "."
'Weitersuchen
Set rngFound = Columns("AA").FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Cells(wzeile(2), "AA") = "."
Loop While rngFound.Address <> strFirstAddress
End If
End Sub
'-------------------------------------'
'Software Option Button Change Event -'
'-------------------------------------'
Private Sub Software_change()
Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String
Dim zeile As Variant
Dim wzeile As Variant
wert = Tabelle1.Software
If wert = True Then
Set rngFound = Columns(7).Find(What:="Software", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Loop While rngFound.Address <> strFirstAddress
End If
If wert = False Then
Set rngFound = Columns(7).Find(What:="Software", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Loop While rngFound.Address <> strFirstAddress
End If
End Sub
'-------------------------------------'
'Hardware Option Button Change Event -'
'-------------------------------------'
Private Sub Hardware_change()
Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String
Dim zeile As Variant
Dim wzeile As Variant
wert = Tabelle1.Hardware
If wert = True Then
Set rngFound = Columns(7).Find(What:="Hardware", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Loop While rngFound.Address <> strFirstAddress
End If
If wert = False Then
Set rngFound = Columns(7).Find(What:="Hardware", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Loop While rngFound.Address <> strFirstAddress
End If
End Sub
'-----------------------------------'
'Gaming Option Button Change Event -'
'-----------------------------------'
Private Sub Gaming_change()
Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String
Dim zeile As Variant
Dim wzeile As Variant
wert = Tabelle1.Gaming
If wert = True Then
Set rngFound = Columns(7).Find(What:="Gaming", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Loop While rngFound.Address <> strFirstAddress
End If
If wert = False Then
Set rngFound = Columns(7).Find(What:="Gaming", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Loop While rngFound.Address <> strFirstAddress
End If
End Sub
'-----------------------------------------'
'Grafikdesign Option Button Change Event -'
'-----------------------------------------'
Private Sub Grafikdesign_change()
Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String
Dim zeile As Variant
Dim wzeile As Variant
wert = Tabelle1.Grafikdesign
If wert = True Then
Set rngFound = Columns(7).Find(What:="Grafikdesign", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Loop While rngFound.Address <> strFirstAddress
End If
If wert = False Then
Set rngFound = Columns(7).Find(What:="Grafikdesign", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Loop While rngFound.Address <> strFirstAddress
End If
End Sub
'----------------------------------'
'Musik Option Button Change Event -'
'----------------------------------'
Private Sub Musik_change()
Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String
Dim zeile As Variant
Dim wzeile As Variant
wert = Tabelle1.Musik
If wert = True Then
Set rngFound = Columns(7).Find(What:="Musik", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Loop While rngFound.Address <> strFirstAddress
End If
If wert = False Then
Set rngFound = Columns(7).Find(What:="Musik", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Loop While rngFound.Address <> strFirstAddress
End If
End Sub
'-------------------------------------------'
'Programmierung Option Button Change Event -'
'-------------------------------------------'
Private Sub Programmierung_change()
Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String
Dim zeile As Variant
Dim wzeile As Variant
wert = Tabelle1.Programmierung
If wert = True Then
Set rngFound = Columns(7).Find(What:="Programmierung", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Loop While rngFound.Address <> strFirstAddress
End If
If wert = False Then
Set rngFound = Columns(7).Find(What:="Programmierung", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Loop While rngFound.Address <> strFirstAddress
End If
End Sub
'------------------------------------------'
'Burning Board Option Button Change Event -'
'------------------------------------------'
Private Sub WBB_change()
Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String
Dim zeile As Variant
Dim wzeile As Variant
wert = Tabelle1.WBB
If wert = True Then
Set rngFound = Columns(7).Find(What:="Burning Board", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Loop While rngFound.Address <> strFirstAddress
End If
If wert = False Then
Set rngFound = Columns(7).Find(What:="Burning Board", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Loop While rngFound.Address <> strFirstAddress
End If
End Sub
'----------------------------------'
'Joomla Option Button Change Event -'
'----------------------------------'
Private Sub Joomla_change()
Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String
Dim zeile As Variant
Dim wzeile As Variant
wert = Tabelle1.Joomla
If wert = True Then
Set rngFound = Columns(7).Find(What:="Joomla", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 64, 64)
Loop While rngFound.Address <> strFirstAddress
End If
If wert = False Then
Set rngFound = Columns(7).Find(What:="Joomla", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
Exit Sub
End If
strFirstAddress = rngFound.Address
Do
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Set rngFound = Columns(7).FindNext(rngFound)
wzeile = Split(rngFound.Address, "$")
zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
Range(zeile).Interior.Color = RGB(255, 255, 255)
Loop While rngFound.Address <> strFirstAddress
End If
End Sub
Ich möchte zu gerne noch eine Password Abfrage per Userform machen aber da bin ich im Moment überfragt wie ich das machen kann. Die Userform soll auf jeden Fall aufpopen wenn Excel gestartet wird. Nur komme ich da in den Konflikt mit den User definierten Sicherheitsregeln für Makros da die Userform ja net ausgeführt wird wenn dem Makro nicht vertraut wird. Dann kann ich mit Abfrage auch sparen oder.
|