Zeile Rahmenfarbe
#1
Hallo zusammen.

Ich habe folgenden Code, der die gesuchte Zeile in Spalte A farblich markiert. (funzt!)

Code:
Sub BarcodeSuchen()

'Blattschutz aufheben
shProdukte.Unprotect

Dim Targetstr As String
Dim x As Variant

Range("A:A").Interior.Color = xlNone
Range("A:A").Borders.LineStyle = xlNone
Range("A:A").Borders.Color = RGB(255, 255, 255)

Targetstr = "(" & Range("barcode").Value & ")": If Targetstr = "" Then Exit Sub
With Worksheets("Produkte")
x = Application.Match(Targetstr, .Columns(4), 0)
If IsNumeric(x) Then
With .Cells(x, 1)
.Interior.Color = RGB(226, 107, 10)
.Borders.LineStyle = -4142
.Borders.Color = RGB(226, 107, 10)
.Select

If [c_aus] Then
Range("G" & x) = Range("G" & x) - Range("D4")
Range("barcode").Select
End If

If [c_ein] Then
Range("G" & x) = Range("G" & x) + Range("D4")
Range("barcode").Select
End If

End With

Else
MsgBox "Der Artikel (Barcode) wurde nicht gefunden!", vbInformation, "Suchergebnis"
End If
End With

End Sub


Wie bekomme ich es hin, dass er die gleiche Farbe als Außenrahmenfarbe Spalte B bis G in der gefundenen Zeile setzt?

Natürlich müsste er die Außenrahmenfarbe Spalte B bis G  beim nächsten suchen wieder in der vorigen Zeile zurüch setzen.

Danke für eure Hilfe
Antworten Top
#2
Hallo, Um das Problem zu lösen, dass die Rahmenfarben in den Spalten B bis G für die gefundene Zeile gesetzt und zurückgesetzt werden, kannst du Folgendes hinzufügen:

Code:
Sub BarcodeSuchen()

    ' Blattschutz aufheben
    shProdukte.Unprotect

    Dim Targetstr As String
    Dim x As Variant
    Dim lastRow As Long

    ' Zellen in Spalte A zurücksetzen
    Range("A:A").Interior.Color = xlNone
    Range("A:A").Borders.LineStyle = xlNone
    Range("A:A").Borders.Color = RGB(255, 255, 255)

    ' Rahmen in Spalte B bis G zurücksetzen
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    With Range("B1:G" & lastRow)
        .Borders.LineStyle = xlNone
        .Interior.Color = xlNone
    End With

    Targetstr = "(" & Range("barcode").Value & ")": If Targetstr = "" Then Exit Sub
    With Worksheets("Produkte")
        x = Application.Match(Targetstr, .Columns(4), 0)
        If IsNumeric(x) Then
            ' Spalte A färben
            With .Cells(x, 1)
                .Interior.Color = RGB(226, 107, 10)
                .Borders.LineStyle = -4142
                .Borders.Color = RGB(226, 107, 10)
                .Select
            End With
           
            ' Spalte B bis G rahmen und färben
            With .Range("B" & x & ":G" & x)
                .Borders.LineStyle = xlContinuous
                .Borders.Color = RGB(226, 107, 10)
                .Interior.Color = RGB(250, 218, 94) ' Optionale Hintergrundfarbe
            End With

            ' Werte ändern, falls erforderlich
            If [c_aus] Then
                Range("G" & x) = Range("G" & x) - Range("D4")
                Range("barcode").Select
            End If

            If [c_ein] Then
                Range("G" & x) = Range("G" & x) + Range("D4")
                Range("barcode").Select
            End If

        Else
            MsgBox "Der Artikel (Barcode) wurde nicht gefunden!", vbInformation, "Suchergebnis"
        End If
    End With

End Sub
Antworten Top
#3
Verwende 'Styles'. (siehe Macro M_snb)


Angehängte Dateien
.xlsb   _style_snb.xlsb (Größe: 12,35 KB / Downloads: 1)
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#4
Moin,

beachte, dass der Code von Thomasmeyer von einer KI stammt (ich bin übrigens der Meinung, dass so ein Umstand erwähnt werden müsste. Vielleicht sollte eine Kennzeichnungspflicht in die Nutzungsregeln aufgenommen werden)

Viele Grüße 
derHoepp
[-] Folgende(r) 4 Nutzer sagen Danke an derHoepp für diesen Beitrag:
  • Klaus-Dieter, LuckyJoe, schauan, snb
Antworten Top
#5
Vielen Dank. Hab den code noch etwas angepasst.

Code:
Sub BarcodeSuchen()

    Dim Targetstr As String
    Dim x As Variant
    Dim lastRow As Long
    Dim letzte As Long

    ' Zellen in Spalte A zurücksetzen
    Range("A:A").Interior.Color = xlNone
    Range("A:A").Borders.LineStyle = xlNone
    Range("A:A").Borders.Color = RGB(255, 255, 255)

    ' Rahmen in Spalte B bis G zurücksetzen
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    With Range("B8:G" & lastRow)
        .Borders.LineStyle = xlNone
        .Interior.Color = xlNone
    End With

    Targetstr = "(" & Range("barcode").Value & ")": If Targetstr = "" Then Exit Sub
    With Worksheets("Produkte")
        x = Application.Match(Targetstr, .Columns(4), 0)
        If IsNumeric(x) Then
            ' Spalte A färben
            With .Cells(x, 1)
                .Interior.Color = 682978
                .Borders.LineStyle = -4142
                .Borders.Color = RGB(226, 107, 10)
                .Select
                Range("barcode").Select
            End With
           
            ' Spalte B bis G rahmen und färben
            With .Range("B" & x & ":G" & x)
                    '-- Zeilenbereich hervorheben
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = 3    '1-4
                .Borders(xlEdgeTop).Color = 682978                    'braun
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = 3    '1-4
                .Borders(xlEdgeBottom).Color = 682978                 'braun
            End With

            ' Werte ändern, falls erforderlich
            If [c_aus] Then
                Range("G" & x) = Range("G" & x) - Range("D4")
                Range("barcode").Select
            End If

            If [c_ein] Then
                Range("G" & x) = Range("G" & x) + Range("D4")
                Range("barcode").Select
            End If

        Else
'MsgBox "Der Artikel (Barcode) wurde nicht gefunden!", vbInformation, "Suchergebnis"

If MsgBox("Dieser Artikel wurde nicht im System gefunden!" + vbCr + vbCr + "Soll der Artikel im System neu aufgenommen werden?", vbYesNo + vbQuestion, "Neuer Artikel") = vbYes Then

UserForm1.Show

end sub
Antworten Top
#6
Hast du diesen Beitrag übersehen ?

https://www.clever-excel-forum.de/Thread...#pid298813
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#7
Nein hab ich nicht!

Aber so war es einfacher die Farbgebung. Sorry.

So sehr kenne ich mich mit VBA nicht aus.
Antworten Top
#8
Einfacher Huh 22
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#9
Also die Kennzeichnung der zeile klappt ja nun, auch wenn es andere hier anders gemacht hätten. Sorry

Jetzt habe ich ein kleines (größeres) Problem.

Ich hab ein userform

Da werden alle Einträge ab zeile 8 eingelesen (funzt)

Ich kann nach ID oder Produkt suchen (funzt)

wenn ich allerdings suche und dann den gefundenen Artikel anklicke, zeigt er unterhalb Daten aus der falschen zeile an.

Leider finde ich nicht den Fehler.


Angehängte Dateien
.xlsm   Barcode scannen.xlsm (Größe: 104,78 KB / Downloads: 2)
Antworten Top
#10
Hallo,

ersetze
Code:
Me.ListBox1.AddItem shProdukte.Cells(Zeile, 2).Value
durch
Code:
Me.ListBox1.AddItem Zeile
in

Private Sub ID_Change()
Private Sub txtProduktname_Change()


Gruß, Uwe
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: derHoepp, 5 Gast/Gäste