AW: vorhandene Schaltfläche per VBA kopieren
22.11.2012 07:15:35
Wilson
Hallo Beverly,
Mit dem Klick auf dier Schaltfläche öffne ich erst eine UserForm die ich mir auf meine Bedürfnisse erstellt habe und hinter dieser UserForm befindet sich dann der Code.
Ist villeleicht nicht gut programmiert, aber mir kam es so am logischsten vor. Wie gesagt, bin halt ganz neu auf dem Gebiet.
Ich markiere mir immer die gefundene Zelle. Schrift wird fett markiert und blau gefärbt und die Zelle wir gelb eingefärbt. Beim nächsten oder vorherigen Suchergebnis wird die Formatierung immer weitergegeben und in der vorherigen zurückgesetzt.
1. Code Schaltfläche:
Private Sub cmbSuchenSNR_Click()
Dim wks As Worksheet
Dim xlEnd As Long
Set wks = ActiveWorkbook.ActiveSheet
With wks
xlEnd = .Cells(.Rows.Count, 2).End(xlUp).Row
'Schrift fett rückgängig
.Range("B4:B" & xlEnd).Font.Bold = False
'Schrift Farbe der Zelle rückgängig
.Range("B4:B" & xlEnd).Interior.ColorIndex = xlNone
End With
UserForm1.Show
End Sub
2. UserForm
Option Explicit
Private Sub TextBox1_Enter()
With TextBox1
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
Call fktMarkierungenImTabellenblattZuruecksetzen
End If
End Sub
Private Sub UserForm_Initialize()
TextBox1.SetFocus
End Sub
Private Sub cmbSuchen_Click()
Call fktMarkierungenImTabellenblattZuruecksetzen
End Sub
'Zur Info! cmbWeiter_Click und cmbZurueck_Click sind exakt gleich nur Befehle .FindNext
'und .FindPrevious sind unterschiedlich.
Private Sub cmbWeiter_Click()
Dim rngEingabe As Range
Dim xlEnd As Integer
Dim wks As Worksheet
Dim strTest As String
Set wks = ActiveWorkbook.ActiveSheet
With wks
xlEnd = .Cells(.Rows.Count, 2).End(xlUp).Row
strTest = .Name
'Schrift fett rückgängig
.Range("B4:B" & xlEnd).Font.Bold = False
'Schrift Farbe der Zelle rückgängig
.Range("B4:B" & xlEnd).Interior.ColorIndex = xlNone
'Eingabe der gewünschten Sachnummer in die TextBox1
If TextBox1 = "" Then Exit Sub
Set rngEingabe = .Columns(2).FindNext(After:=ActiveCell)
If Not rngEingabe Is Nothing Then
'Gefundene Sachnummer wird ausgewählt
rngEingabe.Select
'Gefundene Sachnummer wird fett markiert
rngEingabe.Font.Bold = True 'Fett
'Zelle mit gefundener Sachnummer wird gelb eingefärbt
With rngEingabe.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535 'oder hier eine andere Farbe
'.TintAndShade = 0
'.PatternTintAndShade = 0
End With
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
Else
MsgBox "Eingegebene Sachnummer ist nicht vorhanden", vbExclamation, "Fehler"
End If
End With
End Sub
Private Sub cmbZurueck_Click()
Dim rngEingabe As Range
Dim xlEnd As Integer
Dim wks As Worksheet
Dim strTest As String
Set wks = ActiveWorkbook.ActiveSheet
With wks
xlEnd = .Cells(.Rows.Count, 2).End(xlUp).Row
strTest = .Name
'Schrift fett rückgängig
.Range("B4:B" & xlEnd).Font.Bold = False
'Schrift Farbe der Zelle rückgängig
.Range("B4:B" & xlEnd).Interior.ColorIndex = xlNone
'Eingabe der gewünschten Sachnummer in die TextBox1
If TextBox1 = "" Then Exit Sub
Set rngEingabe = .Columns(2).FindPrevious(After:=ActiveCell)
If Not rngEingabe Is Nothing Then
'Gefundene Sachnummer wird ausgewählt
rngEingabe.Select
'Gefundene Sachnummer wird fett markiert
rngEingabe.Font.Bold = True 'Fett
'Zelle mit gefundener Sachnummer wird gelb eingefärbt
With rngEingabe.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535 'oder hier eine andere Farbe
'.TintAndShade = 0
'.PatternTintAndShade = 0
End With
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
Else
MsgBox "Eingegebene Sachnummer ist nicht vorhanden", vbExclamation, "Fehler"
End If
End With
End Sub
Private Sub fktMarkierungenImTabellenblattZuruecksetzen()
Dim rngEingabe As Range
Dim xlEnd As Integer
Dim wks As Worksheet
Dim strTest As String
Set wks = ActiveWorkbook.ActiveSheet
With wks
xlEnd = .Cells(.Rows.Count, 2).End(xlUp).Row
strTest = .Name
'Schrift fett rückgängig
.Range("B4:B" & xlEnd).Font.Bold = False
'Schrift Farbe der Zelle rückgängig
.Range("B4:B" & xlEnd).Interior.ColorIndex = xlNone
'Eingabe der gewünschten Sachnummer in die TextBox1
If TextBox1 = "" Then Exit Sub
Set rngEingabe = .Columns(2).Find(What:=TextBox1, LookAt:=xlPart)
If Not rngEingabe Is Nothing Then
'Gefundene Sachnummer wird ausgewählt
rngEingabe.Select
'Gefundene Sachnummer wird fett markiert
rngEingabe.Font.Bold = True 'Fett
'Zelle mit gefundener Sachnummer wird gelb eingefärbt
With rngEingabe.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535 'oder hier eine andere Farbe
'.TintAndShade = 0
'.PatternTintAndShade = 0
End With
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
Else
MsgBox "Eingegebene Sachnummer ist nicht vorhanden", vbExclamation, "Fehler"
End If
End With
End Sub