Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Code in Prozedur einbinden
zurück: psexec Befehl einer Bat als VBA / prüfen ob Datei vorh. weiter: Markierte Zeilen kopieren und Werte aus Zellen in neue Datei Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Feedback Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
ThommyB
Im Profil kannst Du frei den Rang ändern


Verfasst am:
17. Feb 2013, 19:30
Rufname:

Code in Prozedur einbinden - Code in Prozedur einbinden

Nach oben
       Version: Office 2010

Hallo VBA-Profis,

ich komme nicht weiter und benötige mal wieder eure Hilfe. Nachfolgende Prozedur:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'Korrektur
If Intersect(Target, Range("G7:H9200")) Is Nothing Then Exit Sub
Application.EnableEvents = False
With Intersect(Target, Range("G7:H9200"))
    .Replace "/", "-", xlPart, , True
    .Replace "\", "-", xlPart, , True
    .Replace "Gr.", "Groß", xlPart, , True
    .Replace "Kl.", "Klein", xlPart, , True
    .Replace "str.", "straße", xlPart, , True
    .Replace "Str.", "Straße", xlPart, , True
    .Replace "Ch.", "Chaussee", xlPart, , True
End With
Application.EnableEvents = True

End Sub


möchte ich in diese Prozedur einbinden:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

'Alle Texte der Zellbereiche in Großbuchstaben schreiben.
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Me.Range("AI7:AJ9200,AL7:AL9200,T7:T9200,M7:R9200")) Is Nothing Then Exit Sub
    On Error GoTo CleanUp:
    With Target
        If .Value <> "" Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
        End If
    End With
CleanUp:
    Application.EnableEvents = True

'Schriftfarbe in der Zeile ändern
Dim rngCell As Range
Dim rngTarget As Range
Dim bytColor As Byte
Dim a As Range

Set rngTarget = Intersect(Target, Range("AJ7:AJ9200"))
If rngTarget Is Nothing Then Exit Sub

    For Each rngCell In rngTarget
        Select Case rngCell.Value
            Case "BEREITSCHAFT"
                bytColor = 3
            Case Else
                bytColor = 0
       
        End Select
   
        Range(Cells(Target.Row, 1), Cells(Target.Row, 41)).Font.ColorIndex = bytColor 'Schriftfarbe ändern
        'Range(Cells(Target.Row, 1), Cells(Target.Row, 41)).Interior.ColorIndex = bytColor 'Zellenfarbe ändern
   
    Next rngCell
   
'Schreibt "Bereitschaft" in Zelle wenn "X"
If Intersect(Target, Range("AJ7:AJ9200")) Is Nothing Then Exit Sub
 
If Target.Value = "X" Then
 Target.Offset(0, 0) = "Bereitschaft"
 End If
     
End Sub


Ich habe schon einiges probiert, aber ich bekomme es nicht hin. Kann mir jemand helfen?

Besten Dank im Voraus

Thommy
Isabelle :-)
Menschin


Verfasst am:
17. Feb 2013, 20:24
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis


AW: Code in Prozedur einbinden - AW: Code in Prozedur einbinden

Nach oben
       Version: Office 2010

Hallöchen,

so?

Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim objRange As Range, objCell As Range
    Dim vntColorIndex As Variant

    'Alle Texte der Zellbereiche in Großbuchstaben schreiben.
    Set objRange = Intersect(Target, Range("AI7:AJ9200,AL7:AL9200,T7:T9200,M7:R9200"))

    If Not objRange Is Nothing Then

        Application.EnableEvents = False

        For Each objCell In objRange

            With objCell

                If Not IsEmpty(.Value) Then .Value = UCase$(.Value)

            End With
        Next

        Application.EnableEvents = True

    End If


    'Schriftfarbe in der Zeile ändern
    Set objRange = Intersect(Target, Range("AJ7:AJ9200"))

    If Not objRange Is Nothing Then

        Application.EnableEvents = False

        For Each objCell In objRange

            With objCell

                'Schreibt "Bereitschaft" in Zelle wenn "X"
                If .Value = "X" Then .Value = "Bereitschaft"

                Select Case .Value

                    Case "BEREITSCHAFT"

                        vntColorIndex = 3

                    Case Else

                        vntColorIndex = xlColorIndexAutomatic

                End Select
            End With

            'Schriftfarbe ändern
            Cells(objCell.Row, 1).Resize(1, 41).Font.ColorIndex = vntColorIndex

            'Zellenfarbe ändern
            'Cells(objCell.Row, 1).Resize(1, 41).Interior.ColorIndex = vntColorIndex

        Next
    End If

    'Korrektur
    Set objRange = Intersect(Target, Range("G7:H9200"))

    If Not objRange Is Nothing Then

        Application.EnableEvents = False

        With objRange

            .Replace "/", "-", xlPart, , True
            .Replace "\", "-", xlPart, , True
            .Replace "Gr.", "Groß", xlPart, , True
            .Replace "Kl.", "Klein", xlPart, , True
            .Replace "str.", "straße", xlPart, , True
            .Replace "Str.", "Straße", xlPart, , True
            .Replace "Ch.", "Chaussee", xlPart, , True

        End With

        Application.EnableEvents = True

    End If
End Sub

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
ThommyB
Im Profil kannst Du frei den Rang ändern


Verfasst am:
17. Feb 2013, 22:02
Rufname:

AW: Code in Prozedur einbinden - AW: Code in Prozedur einbinden

Nach oben
       Version: Office 2010

Hallo Isabelle,

besten Dank für deine schnelle Antwort. Leider muß ich dir mitteilen, dass der Code nicht funktioniert. Er läuft einmal durch, in der nächsten Zeile geht dann nichts mehr. Weiterhin sollte sich bei dem Eintrag "Bereitschaft" die Schrift in der Zeile rot färben, welches auch einmal funktionierte. Beim entfernen des Wortes "Bereitschaft" bleibt die Schrift in der Zeile rot und nicht wie gewünscht zurück in schwarz.

Ich werde wohl auf die Einbindung der Prozedur verzichten müssen.

Nochmals besten Dank

liebe Grüße Thommy
theoS
WORD/Excel Erfahren und VBA Bastler


Verfasst am:
17. Feb 2013, 23:31
Rufname: theo

AW: Code in Prozedur einbinden - AW: Code in Prozedur einbinden

Nach oben
       Version: Office 2010

Hallo ThommyB,

ich hätte da so eine Idee...

zuerst mal habe ich deine Prozeduren in Funktionen umgewandelt...
zuerst ein "Modul" einfügen,
Die beiden Funktioinen rufe ich dann im Arbeitsblatt auf...

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Call Korrektor(Target)
Call Bunter(Target)

End Sub


Das ist dann der Code, wie er im Moduls stehen soll
Code:
Function Korrektor(ByVal Target As Range)

'Korrektur
If Intersect(Target, Range("G7:H9200")) Is Nothing Then Exit Function
Application.EnableEvents = False
With Intersect(Target, Range("G7:H9200"))
    .Replace "/", "-", xlPart, , True
    .Replace "\", "-", xlPart, , True
    .Replace "Gr.", "Groß", xlPart, , True
    .Replace "Kl.", "Klein", xlPart, , True
    .Replace "str.", "straße", xlPart, , True
    .Replace "Str.", "Straße", xlPart, , True
    .Replace "Ch.", "Chaussee", xlPart, , True
End With
Application.EnableEvents = True

End Function

Function Bunter(ByVal Target As Range)

'Alle Texte der Zellbereiche in Großbuchstaben schreiben.
    If Target.Cells.Count > 1 Then Exit Function
    Set intSet = Intersect(Target, ActiveSheet.Range("AI7:AJ9200,AL7:AL9200,T7:T9200,M7:R9200"))
    If intSet Is Nothing Then Exit Function
    On Error GoTo CleanUp:
    With Target
        If .Value <> "" Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
        End If
    End With
CleanUp:
    Application.EnableEvents = True

'Schriftfarbe in der Zeile ändern
Dim rngCell As Range
Dim rngTarget As Range
Dim bytColor As Byte
Dim a As Range

Set rngTarget = Intersect(Target, Range("AJ7:AJ9200"))
If rngTarget Is Nothing Then Exit Function

    For Each rngCell In rngTarget
        Select Case rngCell.Value
            Case "BEREITSCHAFT"
                bytColor = 3
            Case Else
                bytColor = 0
       
        End Select
   
        Range(Cells(Target.Row, 1), Cells(Target.Row, 41)).Font.ColorIndex = bytColor 'Schriftfarbe ändern
        'Range(Cells(Target.Row, 1), Cells(Target.Row, 41)).Interior.ColorIndex = bytColor 'Zellenfarbe ändern
   
    Next rngCell
   
'Schreibt "Bereitschaft" in Zelle wenn "X"
If Intersect(Target, Range("AJ7:AJ9200")) Is Nothing Then Exit Function
 
If Target.Value = "X" Then
 Target.Offset(0, 0) = "Bereitschaft"
 End If
     
End Function


Hab jetzt nicht alles getestet, aber schien mir zu funktionieren.

Vorteil des Ganzen ist auch, wenn du diese Funktionen in mehreren Blättern brauchst, kannst du die jederzeit mit den paar Zeilen Code am Anfang aufrufen.

Probiers mal.

viele Grüße Theo

_________________
theo s.
Isabelle :-)
Menschin


Verfasst am:
17. Feb 2013, 23:58
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis

AW: Code in Prozedur einbinden - AW: Code in Prozedur einbinden

Nach oben
       Version: Office 2010

Hallöchen,

da fehlte ein

Application.EnableEvents = True

und BEREITSCHAFT war eimal mit Großbuchstaben und einmal "normal" geschrieben.

also:

Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim objRange As Range, objCell As Range
    Dim vntFontColorIndex As Variant, vntInteriorColorIndex As Variant

    'Alle Texte der Zellbereiche in Großbuchstaben schreiben.
    Set objRange = Intersect(Target, Range("AI7:AJ9200,AL7:AL9200,T7:T9200,M7:R9200"))

    If Not objRange Is Nothing Then

        Application.EnableEvents = False

        For Each objCell In objRange

            With objCell

                If Not IsEmpty(.Value) Then .Value = UCase$(.Value)

            End With
        Next

        Application.EnableEvents = True

    End If


    'Schriftfarbe in der Zeile ändern
    Set objRange = Intersect(Target, Range("AJ7:AJ9200"))

    If Not objRange Is Nothing Then

        Application.EnableEvents = False

        For Each objCell In objRange

            With objCell

                'Schreibt "Bereitschaft" in Zelle wenn "X"
                If .Value = "X" Then .Value = "BEREITSCHAFT"

                Select Case .Value

                    Case "BEREITSCHAFT"

                        vntFontColorIndex = 3
                        vntInteriorColorIndex = 3

                    Case Else

                        vntFontColorIndex = xlColorIndexAutomatic
                        vntInteriorColorIndex = xlColorIndexNone

                End Select
            End With

            'Schriftfarbe ändern
            Cells(objCell.Row, 1).Resize(1, 41).Font.ColorIndex = vntFontColorIndex

            'Zellenfarbe ändern
            'Cells(objCell.Row, 1).Resize(1, 41).Interior.ColorIndex = vntInteriorColorIndex

        Next

        Application.EnableEvents = True

    End If

    'Korrektur
    Set objRange = Intersect(Target, Range("G7:H9200"))

    If Not objRange Is Nothing Then

        Application.EnableEvents = False

        With objRange

            .Replace "/", "-", xlPart, , True
            .Replace "\", "-", xlPart, , True
            .Replace "Gr.", "Groß", xlPart, , True
            .Replace "Kl.", "Klein", xlPart, , True
            .Replace "str.", "straße", xlPart, , True
            .Replace "Str.", "Straße", xlPart, , True
            .Replace "Ch.", "Chaussee", xlPart, , True

        End With

        Application.EnableEvents = True

    End If
End Sub

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
ThommyB
Im Profil kannst Du frei den Rang ändern


Verfasst am:
18. Feb 2013, 09:42
Rufname:


AW: Code in Prozedur einbinden - AW: Code in Prozedur einbinden

Nach oben
       Version: Office 2010

Hallo Isi, hallo Theo,

ich bin begeistert. Ich verneige mich vor euch und möchte mich für eure Bemühungen bedanken. Es funktionieren beide Prozeduren. Die Auswahl fällt mir nicht schwer, denn ich habe mehrere Tabellenblätter und werde beide nutzen.

Danke, Danke, Danke!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Liebe Grüße von der Insel Rügen

Thommy
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Zeilennummern in Matrix einbinden 5 Chri 77 19. Sep 2012, 16:40
Chri Zeilennummern in Matrix einbinden
Keine neuen Beiträge Excel Formeln: Farbige Schrift / Unterlegung in Excel Formel einbinden 2 AngelusBT 477 02. Apr 2012, 12:14
AngelusBT Farbige Schrift / Unterlegung in Excel Formel einbinden
Keine neuen Beiträge Excel Formeln: Suchfunktion in Excel einbinden 1 reinige 776 22. Feb 2012, 17:54
< Peter > Suchfunktion in Excel  einbinden
Keine neuen Beiträge Excel Formeln: Gegenteil von code() 3 Qwertzuiop 487 26. Aug 2011, 17:22
Gast Gegenteil von code()
Keine neuen Beiträge Excel Formeln: PDF in Excel einbinden und per Mail verschicken 0 MaYi 1302 07. Jun 2011, 12:13
MaYi PDF in Excel einbinden und per Mail verschicken
Keine neuen Beiträge Excel Formeln: Worksheet.Function.Average bei Variablen im VBA Code 0 Jwk 1210 23. Jan 2011, 15:47
Jwk Worksheet.Function.Average bei Variablen im VBA Code
Keine neuen Beiträge Excel Formeln: Wert aus Zelle in Prosatext von Zelle zwei einbinden 3 Cinexclusive 1003 01. Dez 2010, 10:43
Cinexclusive Wert aus Zelle in Prosatext von Zelle zwei einbinden
Dieses Thema ist gesperrt, du kannst keine Beiträge editieren oder beantworten. Excel Formeln: Farbumschlag über Code (ALT+11) formatieren 2 Viper85 896 24. Sep 2010, 08:33
Thomas Ramel Farbumschlag über Code (ALT+11) formatieren
Keine neuen Beiträge Excel Formeln: Excelverknüpfung zeigt nur Code an 6 Sesla 982 11. Aug 2010, 13:20
Sesla Excelverknüpfung zeigt nur Code an
Dieses Thema ist gesperrt, du kannst keine Beiträge editieren oder beantworten. Excel Formeln: Excel 2003 Add-in in Excel 2007 einbinden 2 Herje 3104 22. Jun 2010, 11:19
< Peter > Excel 2003 Add-in in Excel 2007 einbinden
Keine neuen Beiträge Excel Formeln: VBA code? zellen mit bedingung rot oder grün darstellen!? 1 yusuf 978 20. Apr 2010, 18:37
unti23 VBA code? zellen mit bedingung rot oder grün darstellen!?
Keine neuen Beiträge Excel Formeln: Wert aus Zelle in Formel einbinden 9 Kunii 1193 23. Okt 2009, 15:13
BoskoBiati Wert aus Zelle in Formel einbinden
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: PHP JavaScript