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
456to460
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
456to460
456to460
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro soll nicht aus der Zelle springen

Makro soll nicht aus der Zelle springen
17.07.2004 21:36:31
Andi
Wie soll ich das Makro umschreiben, dass ich beim ausführen des Makros nicht aus der Zelle springe ? Ich will, das mein Cursor dort bleibt, wo ich meine Daten eingebe.
Hier mein Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("N43") = "Mannschaft 1" Then
Call sieger1_hervorheben
Else
Call sieger2_hervorheben
End If
End Sub

Sub sieger1_hervorheben()
ActiveSheet.Shapes("Text Box 180").Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 53
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 1
ActiveSheet.Shapes("Text Box 179").Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 48
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 1

End Sub
Sub sieger2_hervorheben()
ActiveSheet.Shapes("Text Box 179").Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 53
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 1
ActiveSheet.Shapes("Text Box 180").Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 48
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 1

End Sub

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Warum mit neuem Namen ?
Ramses
Hallo
warum das auslösende Ereignis ein Change - Ereignis sein muss verstehe ich zwar nicht,.. aber dann mach es so.
Setze an die letze Zeile deines Codes im Worksheet_Change Ereignis die Zeile
Target.Select
Gruss Rainer
AW: Warum mit neuem Namen ?
17.07.2004 22:05:22
andi
Cool danke...aber gibt es noch ein Befehl wo der Cursor gar nicht "angetastet" wird und ich nix davon merke das ein makro gelaufen ist?
AW: Warum mit neuem Namen ?
17.07.2004 22:07:44
Nepumuk
Hallo,
klar, so:


Sub sieger1_hervorheben()
    With ActiveSheet.Shapes("Text Box 180")
        With .Fill
            .Transparency = 0#
            .Visible = msoTrue
            .ForeColor.SchemeColor = 8
            .BackColor.SchemeColor = 53
            .TwoColorGradient msoGradientVertical, 1
        End With
        With .Line
            .Weight = 0.75
            .DashStyle = msoLineSolid
            .Style = msoLineSingle
            .Transparency = 0#
            .Visible = msoFalse
        End With
    End With
    With ActiveSheet.Shapes("Text Box 179")
        With .Fill
            .Transparency = 0#
            .Visible = msoTrue
            .ForeColor.SchemeColor = 8
            .BackColor.SchemeColor = 48
            .TwoColorGradient msoGradientVertical, 1
        End With
        With .Line
            .Weight = 0.75
            .DashStyle = msoLineSolid
            .Style = msoLineSingle
            .Transparency = 0#
            .Visible = msoFalse
        End With
    End With
End Sub
Sub sieger2_hervorheben()
    With ActiveSheet.Shapes("Text Box 179")
        With .Fill
            .Transparency = 0#
            .Visible = msoTrue
            .ForeColor.SchemeColor = 8
            .BackColor.SchemeColor = 53
            .TwoColorGradient msoGradientVertical, 1
        End With
        With .Line
            .Weight = 0.75
            .DashStyle = msoLineSolid
            .Style = msoLineSingle
            .Transparency = 0#
            .Visible = msoFalse
        End With
    End With
    With ActiveSheet.Shapes("Text Box 180")
        With .Fill
            .Transparency = 0#
            .Visible = msoTrue
            .ForeColor.SchemeColor = 8
            .BackColor.SchemeColor = 48
            .TwoColorGradient msoGradientVertical, 1
        End With
        With .Line
            .Weight = 0.75
            .DashStyle = msoLineSolid
            .Style = msoLineSingle
            .Transparency = 0#
            .Visible = msoFalse
        End With
    End With
End Sub


Gruß
Nepumuk
Anzeige
AW: Warum mit neuem Namen ?
17.07.2004 22:40:59
andi
Boah, danke sehr...die Läsung war super...jetzt geht es.
Aber jetzt kommt das schwierigste, meiner Meinung nach:
Was muss ich jetzt noch oben ändern, in der Privat Sub Worksheet, wenn ich mehrere Textfelder ändern will, mit jeweils anderen Makros (also sieger1_hervorheben1, makro2,makro3,4,5,6,7,8 ....das muss doch irgendwie gehen, oder ?
Hier mein jetztiger Code, mit deiner Hilfe verbessert.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("N43") = "Mannschaft 1" Then
Call sieger1_hervorheben
Else
If Range("N43") = "Mannschaft 4" Then
Call sieger2_hervorheben
End If
End If
End Sub

Sub sieger1_hervorheben()
With ActiveSheet.Shapes("Text Box 180")
With .Fill
.Transparency = 0#
.Visible = msoTrue
.ForeColor.SchemeColor = 8
.BackColor.SchemeColor = 53
.TwoColorGradient msoGradientVertical, 1
End With
With .Line
.Weight = 0.75
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Transparency = 0#
.Visible = msoFalse
End With
End With
With ActiveSheet.Shapes("Text Box 179")
With .Fill
.Transparency = 0#
.Visible = msoTrue
.ForeColor.SchemeColor = 8
.BackColor.SchemeColor = 48
.TwoColorGradient msoGradientVertical, 1
End With
With .Line
.Weight = 0.75
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Transparency = 0#
.Visible = msoFalse
End With
End With
End Sub
Sub sieger2_hervorheben()
With ActiveSheet.Shapes("Text Box 179")
With .Fill
.Transparency = 0#
.Visible = msoTrue
.ForeColor.SchemeColor = 8
.BackColor.SchemeColor = 53
.TwoColorGradient msoGradientVertical, 1
End With
With .Line
.Weight = 0.75
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Transparency = 0#
.Visible = msoFalse
End With
End With
With ActiveSheet.Shapes("Text Box 180")
With .Fill
.Transparency = 0#
.Visible = msoTrue
.ForeColor.SchemeColor = 8
.BackColor.SchemeColor = 48
.TwoColorGradient msoGradientVertical, 1
End With
With .Line
.Weight = 0.75
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Transparency = 0#
.Visible = msoFalse
End With
End With
End Sub
Anzeige
AW: Warum mit neuem Namen ?
17.07.2004 23:22:48
andi
Hat niemand eine Idee?
AW: Warum mit neuem Namen ?
Boris
Hi Mr. Pole,
ich bleibe dabei - das ist alles unnötiger Overhead. Du schaffst dir hier künstlich Probleme, die du nicht hättest, wenn du Excel dazu verwendest, wofür es da ist. Shapes sind zwar schön, aber eben für "VBA-Nein" für Dein Vorhaben nicht zu gebrauchen.
Bitte nicht falsch verstehen - das soll nur ein gut gemeinter Tipp sein.
Grüße Boris
AW: Bin ja fast fertig
17.07.2004 23:45:02
andi
Habs fast fertig nur das eine Makro muss noch funzen, dann ist die Tabelle KOMPLETT.
Also hier mein Makrokopf, aber so funktionieren die nächsten Makros nicht.
Muss ich die IF THEN Schleifen anders setzen ?
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("N43") = "Mannschaft 1" Then
Call sieger1_hervorheben
Else
If Range("N43") = "Mannschaft 4" Then
Call sieger2_hervorheben
Else
Call niemand_hervorheben
If Range("N46") = "Mannschaft 2" Then
Call sieger1_hervorheben2
Else
If Range("N46") = "Mannschaft 5" Then
Call sieger2_hervorheben2
Else
Call niemand_hervorheben2
End If
End If
End If
End If
End Sub

Verstehe es nicht falsch Boris, aber ich hab jetzt ne Woche an der Tabelle jetzt rumgesessen, und ich kann das doch jetzt nicht umschreiben, weil es für dich nicht zu gebrauchen scheint.
Anzeige
AW: Bin ja fast fertig
Boris
Hi Andi,
Verstehe es nicht falsch Boris, aber ich hab jetzt ne Woche an der Tabelle jetzt rumgesessen, und ich kann das doch jetzt nicht umschreiben, weil es für dich nicht zu gebrauchen scheint.
Ich hab nicht gesagt, dass es grundsätzlich nicht zu gebrauchen ist - eben nur für "VBA-Nein". Denn du wärst wahrscheinlich bereits seit 6 Tagen mit der Mappe fertig, hättest du dich auf die ZELLEN konzentriert.
Aber der Kunde ist König...:)p
Grüße Boris
AW: Bin ja fast fertig
18.07.2004 00:01:46
andi
Ja, ich hab vielleicht den falschen Weg genommen. Aber ich wollte das es schön aussieht mit Farbverläufen. Aber wir reden jetzt um den heissen Brei rum.
Ich muss nur eine klitzekleine Änderung an meinem Makro machen.
Bitte, dann belästige ich euch nicht mehr. :-(
Anzeige
AW: Bin ja fast fertig
Boris
Hi Andi,
mit Application.Caller erhälst du die Namen der Textfelder - darauf kannst du entsprechend reagieren.
Aber lad doch einfach mal deine Datei hier hoch - dann wird´s um einiges einfacher...
Grüße Boris
Das war natürlich Nonsens...
Boris
...vergiss es einfach - bis auf den letzten Satz (Mappe hochladen).
Boris
AW: Bin ja fast fertig
18.07.2004 00:29:23
andi
Leichter gesagt als getan....die Datei ist viel zu gross fürs Upload, muss sie erst verkleinern.
AW: Hallo Boris
18.07.2004 12:08:55
andi
Hi Boris
Kannst du mit der Mappe was anfangen?
Anzeige
AW: NEPUMUK HILF MIR !!!
17.07.2004 23:46:55
andi
Oben das makro, wenn das funzt bin ich am Ziel......

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige