Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
732to736
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
732to736
732to736
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

SelectionChange

SelectionChange
Gerhard
Hallo!
Bitte um Eure Hilfe! Ich habe zwei SelectionChange Codes, die beide für sich funktionieren aber ich brauche sie für ein Tabellenblatt.
Wenn ich sie zusmmenfüge funktioniert entweder der eine oder der andere was immer ich auch versuche. Was kann ich machen damit ich beide verwenden kann?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Ausblenden
Static Row As Range
Call BlattschutzAus
ActiveSheet.Range("3:231").Font.Size = "10"
ActiveSheet.Range("3:231").EntireRow.RowHeight = "14"
ActiveSheet.Range("A3:C231").Interior.ColorIndex = "19"
ActiveSheet.Range("D3:D231").Interior.ColorIndex = "24"
ActiveSheet.Range("A3:M231").Font.ColorIndex = xlAutomatic
Call Blattschutz
On Error GoTo Schluss
If Target.Column = 4 Then
If Target.Row >= 3 And Target.Row < 231 Then
If Target.Offset(0, -1) <> "" Then
Call BlattschutzAus
Vergrößern Target.Offset(0, -1).Address(False, False)
Rows(Target.Row).Font.Size = "19"
Rows(Target.Row).RowHeight = "28"
Rows(Target.Row).Interior.ColorIndex = xlColorIndexNone
Target.Offset(0, -1).Font.ColorIndex = "3"
Target.Offset(0, -1).Font.Size = "29"
Call Blattschutz
End If
Else
Call BlattschutzAus
Anzeige_löschen
Call Blattschutz
End If
Else
Call BlattschutzAus
Anzeige_löschen
Call Blattschutz
End If
Exit Sub
Schluss:
Call BlattschutzAus
Anzeige_löschen
Call Blattschutz
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strSuche As String
Dim rngFind As Range
Dim AktiveZ As String
Dim AktiveZeile As String
AktiveZeile = ActiveCell.Row
' Wenn nicht Spalte B im Bereich von 3 bis 231 dann raus hier.
' Wenn Aktive Zeile Spalte A leer dann Exit Sub
If Intersect(Target, Range("C3:C231")) Is Nothing Then Exit Sub
If Range("A" & AktiveZeile) = "" Then Exit Sub
' Suchbegriff aus den Spalten A und B des 1. Blattes aus KundeListe zusammen.
strSuche = ActiveSheet.Cells(Target.Row, 5).Text & ActiveSheet.Cells(Target.Row, 2).Text
' Mappe Bestand muss geöffnet sein, bei Bedarf kann Sie hier über Workbooks.Open auch
' geöffnet werden.
With Workbooks(strNameDatenbank).Sheets("Gesamtbestand").Columns(1)
Set rngFind = .Find(What:=strSuche, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If rngFind Is Nothing Then
MsgBox "Die Identnummer '" & strSuche & "' ist in der Datenbank nicht angelegt !", vbCritical
AktiveZ = ActiveCell.Row
Range("A" & AktiveZ).Select
Range("A" & AktiveZ & ":B" & AktiveZ).ClearContents
End If
End With
End Sub

Gruss
Grahrd

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: SelectionChange
13.02.2006 23:25:16
Josef
Hallo Gerhard!
Probier mal so!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strSuche As String
Dim rngFind As Range
Dim AktiveZ As String
Dim AktiveZeile As String
Static Row As Range

Ausblenden

Call BlattschutzAus
Range("3:231").Font.Size = "10"
Range("3:231").EntireRow.RowHeight = "14"
Range("A3:C231").Interior.ColorIndex = "19"
Range("D3:D231").Interior.ColorIndex = "24"
Range("A3:M231").Font.ColorIndex = xlAutomatic
Call Blattschutz

On Error GoTo Schluss

If Target.Column = 4 Then
  If Target.Row >= 3 And Target.Row < 231 Then
    If Target.Offset(0, -1) <> "" Then
      Call BlattschutzAus
      Vergrößern Target.Offset(0, -1).Address(False, False)
      Rows(Target.Row).Font.Size = "19"
      Rows(Target.Row).RowHeight = "28"
      Rows(Target.Row).Interior.ColorIndex = xlColorIndexNone
      Target.Offset(0, -1).Font.ColorIndex = "3"
      Target.Offset(0, -1).Font.Size = "29"
      Call Blattschutz
    End If
  End If
Else
  Call BlattschutzAus
  Anzeige_löschen
  Call Blattschutz
End If

AktiveZeile = ActiveCell.Row
' Wenn nicht Spalte B im Bereich von 3 bis 231 dann raus hier.
' Wenn Aktive Zeile Spalte A leer dann Exit Sub
If Intersect(Target, Range("C3:C231")) Is Nothing Then GoTo Schluss
If Range("A" & AktiveZeile) = "" Then GoTo Schluss

' Suchbegriff aus den Spalten A und B des 1. Blattes aus KundeListe zusammen.
strSuche = ActiveSheet.Cells(Target.Row, 5).Text & ActiveSheet.Cells(Target.Row, 2).Text
' Mappe Bestand muss geöffnet sein, bei Bedarf kann Sie hier über Workbooks.Open auch
' geöffnet werden.
With Workbooks(strNameDatenbank).Sheets("Gesamtbestand").Columns(1)
  Set rngFind = .Find(What:=strSuche, LookIn:=xlValues, LookAt:= _
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
  If rngFind Is Nothing Then
    MsgBox "Die Identnummer '" & strSuche & "' ist in der Datenbank nicht angelegt !", vbCritical
    AktiveZ = ActiveCell.Row
    Range("A" & AktiveZ).Select
    Range("A" & AktiveZ & ":B" & AktiveZ).ClearContents
  End If
End With

Exit Sub
Schluss:
Call BlattschutzAus
Anzeige_löschen
Call Blattschutz
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: SelectionChange
14.02.2006 19:37:59
Gerhard
Hallo Sepp!
Danke für Deine Hilfe! Funktioniert bis auf eine Kleinigkeit super. Ich habe immer ein Fenster gehabt wo der Wert der Spalte C vergrössert dargestellt wurde ich glaube es ist diese Zeile:
Vergrößern Target.Offset(0, -1).Address(False, False)
Dazugehören tun dann fogende Codes die ich in einem Modul stehen habe:

Sub Vergrößern(Zelle As String)
Anzeige_löschen
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 231.55, ActiveCell.Top, _
190, 55.55).Select
'ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 5, 59.25, _
'    170, 45#).Select
Selection.Name = "Anzeige"
Selection.HorizontalAlignment = xlCenter
Selection.Characters.Text = "Produktionslinie" & Chr(10) & Range(Zelle)
With Selection.Characters(Start:=1, Length:=Len(Selection.Text)).Font
.Name = "Tahoma"
.FontStyle = "Fett"
.Size = 20
.ColorIndex = 5
End With
Range(Zelle).Offset(0, 1).Select
End Sub


Sub Anzeige_löschen()
On Error GoTo Ende
ActiveSheet.Shapes("Anzeige").Select
Selection.Delete
Ende:
End Sub

Ich habe von VBA zuwenig Ahnung als dass ich den Fehler finde! Vieleicht kannst Du Dir das noch einmal anschauen.
Mit Besten Dank und Gruss
Gerhard
Anzeige
AW: SelectionChange
14.02.2006 19:57:45
Josef
Hallo Gerhard!
Probier's mal so!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strSuche As String
Dim rngFind As Range
Dim AktiveZ As String
Dim AktiveZeile As String
Static Row As Range

Ausblenden

Call BlattschutzAus
Range("3:231").Font.Size = "10"
Range("3:231").EntireRow.RowHeight = "14"
Range("A3:C231").Interior.ColorIndex = "19"
Range("D3:D231").Interior.ColorIndex = "24"
Range("A3:M231").Font.ColorIndex = xlAutomatic
Call Blattschutz

On Error GoTo Schluss

If Target.Column = 4 Then
  If Target.Row >= 3 And Target.Row < 231 Then
    If Target.Offset(0, -1) <> "" Then
      Call BlattschutzAus
      Vergrößern Target.Offset(0, -1).Address(False, False)
      Rows(Target.Row).Font.Size = "19"
      Rows(Target.Row).RowHeight = "28"
      Rows(Target.Row).Interior.ColorIndex = xlColorIndexNone
      Target.Offset(0, -1).Font.ColorIndex = "3"
      Target.Offset(0, -1).Font.Size = "29"
      Call Blattschutz
    End If
  Else
    Call BlattschutzAus
    Anzeige_löschen
    Call Blattschutz
  End If
Else
  Call BlattschutzAus
  Anzeige_löschen
  Call Blattschutz
End If

AktiveZeile = ActiveCell.Row
' Wenn nicht Spalte B im Bereich von 3 bis 231 dann raus hier.
' Wenn Aktive Zeile Spalte A leer dann Exit Sub
If Intersect(Target, Range("C3:C231")) Is Nothing Then GoTo Schluss
If Range("A" & AktiveZeile) = "" Then GoTo Schluss

' Suchbegriff aus den Spalten A und B des 1. Blattes aus KundeListe zusammen.
strSuche = ActiveSheet.Cells(Target.Row, 5).Text & ActiveSheet.Cells(Target.Row, 2).Text
' Mappe Bestand muss geöffnet sein, bei Bedarf kann Sie hier über Workbooks.Open auch
' geöffnet werden.
With Workbooks(strNameDatenbank).Sheets("Gesamtbestand").Columns(1)
  Set rngFind = .Find(What:=strSuche, LookIn:=xlValues, LookAt:= _
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
  If rngFind Is Nothing Then
    MsgBox "Die Identnummer '" & strSuche & "' ist in der Datenbank nicht angelegt !", vbCritical
    AktiveZ = ActiveCell.Row
    Range("A" & AktiveZ).Select
    Range("A" & AktiveZ & ":B" & AktiveZ).ClearContents
  End If
End With

Exit Sub
Schluss:
Call BlattschutzAus
Anzeige_löschen
Call Blattschutz
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: SelectionChange
14.02.2006 21:36:28
Gerhard
Hallo Sepp!
Leider auch nicht! Was ich noch sagen wollte ist ich brauche diese zwei Sachen nie gleichzeitig. Wenn die Geschichte mit dem Zeilen Vergrössern aktiv ist brauche ich die Abfrage in der andern Datenbank nicht und wenn ich die Eingabe mache dann brauche ich die Zeilen Geschichte nicht. Bei der Eingabe und Abfrage ist bei den Spalten A B C u. G. der Blattschutz ausgeschaltet die anderen sind gesperrt. Wenn ich die Vergrösserung brauche dann ist nur die Spalte D aktiv und der Blattschutz ausgeschaltet alles andere ist gesperrt, es erfolgt auch ausschliesslich ein Eintrag in Spalte D.
Vieleicht kannst Du damit was anfangen.
Dank u. Gruss
Gerhard
Anzeige
AW: SelectionChange
14.02.2006 21:42:38
Josef
Hallo Gerhard!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strSuche As String
Dim rngFind As Range
Dim AktiveZ As String
Dim AktiveZeile As String
Static Row As Range

AktiveZeile = ActiveCell.Row

If Not Intersect(Target, Range("C3:C231")) Is Nothing Then
  If Range("A" & AktiveZeile) <> "" Then
    
    ' Suchbegriff aus den Spalten A und B des 1. Blattes aus KundeListe zusammen.
    strSuche = ActiveSheet.Cells(Target.Row, 5).Text & ActiveSheet.Cells(Target.Row, 2).Text
    ' Mappe Bestand muss geöffnet sein, bei Bedarf kann Sie hier über Workbooks.Open auch
    ' geöffnet werden.
    With Workbooks(strNameDatenbank).Sheets("Gesamtbestand").Columns(1)
      Set rngFind = .Find(What:=strSuche, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
      If rngFind Is Nothing Then
        MsgBox "Die Identnummer '" & strSuche & "' ist in der Datenbank nicht angelegt !", vbCritical
        AktiveZ = ActiveCell.Row
        Range("A" & AktiveZ).Select
        Range("A" & AktiveZ & ":B" & AktiveZ).ClearContents
      End If
    End With
  End If
Else
  
  Ausblenden
  
  Call BlattschutzAus
  ActiveSheet.Range("3:231").Font.Size = "10"
  ActiveSheet.Range("3:231").EntireRow.RowHeight = "14"
  ActiveSheet.Range("A3:C231").Interior.ColorIndex = "19"
  ActiveSheet.Range("D3:D231").Interior.ColorIndex = "24"
  ActiveSheet.Range("A3:M231").Font.ColorIndex = xlAutomatic
  Call Blattschutz
  On Error GoTo Schluss
  If Target.Column = 4 Then
    If Target.Row >= 3 And Target.Row < 231 Then
      If Target.Offset(0, -1) <> "" Then
        Call BlattschutzAus
        Vergrößern Target.Offset(0, -1).Address(False, False)
        Rows(Target.Row).Font.Size = "19"
        Rows(Target.Row).RowHeight = "28"
        Rows(Target.Row).Interior.ColorIndex = xlColorIndexNone
        Target.Offset(0, -1).Font.ColorIndex = "3"
        Target.Offset(0, -1).Font.Size = "29"
        Call Blattschutz
      End If
    Else
      Call BlattschutzAus
      Anzeige_löschen
      Call Blattschutz
    End If
  Else
    Call BlattschutzAus
    Anzeige_löschen
    Call Blattschutz
  End If
End If
Exit Sub
Schluss:
Call BlattschutzAus
Anzeige_löschen
Call Blattschutz
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: SelectionChange
14.02.2006 23:02:54
Gerhard
Hallo Sepp!
Hezlichsten Dank für Deine Hilfe! Hab noch eine Abfrage eingbaut sonst Fehlermeldung mit aufzurufender Datei: Workbooks(strNameDatenbank).Sheets("Gesamtbestand").Columns(1)
Jetzt funktionierts nur die Anzeige löscht sich nicht wenn ich von Spalte D auf Spalte C klicke, aber damit kann ich leben. Wenn ich auf eine andere Spalte gehe wird die Anzeige gelöscht.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strSuche As String
Dim rngFind As Range
Dim AktiveZ As String
Dim AktiveZeile As String
Static Row As Range
AktiveZeile = ActiveCell.Row
If Not Intersect(Target, Range("C3:C231")) Is Nothing Then
If Range("A" & AktiveZeile) <> "" Then
If Datei_offen(strNameDatenbank) = True Then
' Suchbegriff aus den Spalten A und B des 1. Blattes aus KundeListe zusammen.
strSuche = ActiveSheet.Cells(Target.Row, 5).Text & ActiveSheet.Cells(Target.Row, 2).Text
' Mappe Bestand muss geöffnet sein, bei Bedarf kann Sie hier über Workbooks.Open auch
' geöffnet werden.
With Workbooks(strNameDatenbank).Sheets("Gesamtbestand").Columns(1)
Set rngFind = .Find(What:=strSuche, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If rngFind Is Nothing Then
MsgBox "Die Identnummer '" & strSuche & "' ist in der Datenbank nicht angelegt !", vbCritical
AktiveZ = ActiveCell.Row
Range("A" & AktiveZ).Select
Range("A" & AktiveZ & ":B" & AktiveZ).ClearContents
End If
End With
End If
End If
Else
Ausblenden
Call BlattschutzAus
ActiveSheet.Range("3:231").Font.Size = "10"
ActiveSheet.Range("3:231").EntireRow.RowHeight = "14"
ActiveSheet.Range("A3:C231").Interior.ColorIndex = "19"
ActiveSheet.Range("D3:D231").Interior.ColorIndex = "24"
ActiveSheet.Range("A3:M231").Font.ColorIndex = xlAutomatic
Call Blattschutz
On Error GoTo Schluss
If Target.Column = 4 Then
If Target.Row >= 3 And Target.Row < 231 Then
If Target.Offset(0, -3) <> "" Then
Call BlattschutzAus
Vergrößern Target.Offset(0, -1).Address(False, False)
Rows(Target.Row).Font.Size = "19"
Rows(Target.Row).RowHeight = "28"
Rows(Target.Row).Interior.ColorIndex = xlColorIndexNone
Target.Offset(0, -1).Font.ColorIndex = "3"
Target.Offset(0, -1).Font.Size = "29"
Call Blattschutz
End If
Else
Call BlattschutzAus
Anzeige_löschen
Call Blattschutz
End If
Else
Call BlattschutzAus
Anzeige_löschen
Call Blattschutz
End If
End If
Exit Sub
Schluss:
Call BlattschutzAus
Anzeige_löschen
Call Blattschutz
End Sub


Private Function Datei_offen(n As String) As Boolean
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name = n Then
Datei_offen = True
Exit Function
End If
Next
End Function

Ist das so OK für eine VBA Profi wie Dich ?
Gruss
Gerhard
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige