Office: Benötige Hilfe bei VBA unter Excel 2010

Also ich habe mir jetzt mal einen Pfeil "kreiert" und als Makro aufgezeichnet.
Ich bekomme damit das hier:

Code:

Sub Pfeil()
    ActiveSheet.Shapes.AddShape(msoShapeRightArrow, 3, 30, 54.75, 15).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.6000000238
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.6000000238
        .Transparency = 0.5
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.400000006
        .Transparency = 0
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .Weight = 0.5
    End With
End Sub

Hilft das weiter?

 

Gar nicht, zumindest nicht innerhalb des Codes. Ich habe ganz einfach eine AutoForm auf das Blatt gesetzt, die Rahmenstärke etwas erhöht und rot eingefärbt. Du kannst stattdessen auch jede andere AutoForm benutzen. Wichtig nur, daß der Name der AutoForm dann in der entsprechenden "set" Zeile angepaßt wird.

(Woher die Dinger stammen: In x2003 kannst Du eine Symbolleiste mittels Menü "Ansicht - Symbolleisten - Zeichnen" sichtbar machen und findest darin dann ein Menü mit etlichen Shapes. unter x2007 und aufwärts ist das wohl in irgendwelchen "Ribbons" versteckt, oder?)

Und dazu gehört dann auch die Fehlermeldung, die Du im 2. Posting beschreibst: Du hast keine AutoForm mit dem Namen "AutoForm 1" auf dem Blatt, deswegen fährt das "set" an die Wand. (Allerdings hatte ich gedacht, daß es keinen Fehler produziert, sondern nur ein "nothing" in die Variable setzt, was dann durch das "if" abgefangen worden wäre. *seufz* Schade, müßte man also anders abfangen, mit z.B. "on error goto" und Konsorten.)

Gruß, Michael

 

Hmm, und wie heisst mein Shape nun?
Im Ribbon heisst das nur "Pfeil nach rechts"...

 

Ich weiß nicht, wie das in x2007+ aussieht, aber in x2003 gibt's das Adress-Feld, in dem normalerweise die Zelle steht, auf der sich der Cursor gerade befindet. klickt man ein Shape an, steht dort der Name.

Gruß, Michael

 

Ich krieg' nen Vogel...

Laut Adress-Feld heisst der "Pfeil nach rechts 1"
Laut Makro beim Einfügen heisst der "msoShapeRightArrow"
Laut Makro beim Verschieben heisst der "Right Arrow 1"

In Deinem Code funktioniert keines davon...

 

Hallo,

wäre es denn einfacher möglich beim Öffnen der Datei eine waagerechte Linie unter dem jeweils heutigen Datum von Spalte "B" bis Spalte "I" zu platzieren?

Hoffe ich nerve nicht!?

 

Einfacher, naja... Also was man machen könnte:

Beim Wechsel auf das Blatt könnte man in dem Bereich, in dem nach dem Datum gesucht wird, alle "unteren Ränder" der Zellen löschen und dann beim gefundenen Datum eine z.B. "doppelte Linie" als unteren Rand setzen:

Code:

    [...]
    rng.Borders(xlBottom).LineStyle = xlLineStyleNone
        [...]
        r1.Borders(xlEdgeBottom).LineStyle = xlDouble

Die komplette Routine wäre dann:

Code:

Option Explicit

Private Function FindeHeute(rng As Range) As Range    Dim r As Range

    Dim cell As Range

    rng.Borders(xlBottom).LineStyle = xlLineStyleNone
    Set r = Nothing
    For Each cell In rng
        If Int(cell.Value) = Int(Now()) Then
            Set r = cell
        End If
    Next cell
    Set FindeHeute = r

End Function

Private Sub Worksheet_Activate()

    Dim s1 As Worksheet
    Dim r1 As Range
    'Dim g1 As Shape
    'Dim y1 As Long
    'Dim x1 As Long

    On Error GoTo Err_NoSheet
    Set s1 = Worksheets("Tabelle1")

    On Error GoTo Err_NoShape
    'Set g1 = s1.Shapes("AutoForm 1")

    On Error GoTo 0
    Set r1 = FindeHeute(s1.Range("b6:o6"))
    If (Not r1 Is Nothing) Then
        'y1 = r1.Top
        'x1 = r1.Left
        'g1.Top = y1
        'g1.Left = x1
        'g1.Visible = True
        r1.Borders(xlEdgeBottom).LineStyle = xlDouble
      Else
        'g1.Visible = False
    End If

EndSub:
    Exit Sub

Err_NoSheet:
    MsgBox "Worksheet not found!"
    Resume EndSub

Err_NoShape:
    MsgBox "Shape not found!"
    Resume EndSub

End Sub

Die ganzen Kommentar-Zeilen sind noch die Reste aus der Shape-Positionierung. Die hab ich mal drin gelassen, falls Du das doch noch irgendwie hin bekommst.

Genau wie irgendwelche farblichen Hinterlegungen müßte diese Routine "eigentlich" (aber nicht zwingend) bei jeder Cursor-Bewegung laufen, aber wenn es Dir beim Wechsel auf das Blatt (und ggf. noch beim Öffnen der Mappe) reicht, dann ist das vielleicht erstmal was.

Gruß, Michael

 

Funktioniert leider nicht.
Keine Meldung. Schade.
Ich gebs dann mal auf...

 

Also wenn jetzt keine der aufgezeigten Methoden bei Dir funktioniert... dann... erm... hast Du ein sehr merkwürdiges Excel, würde ich mal so behaupten wollen.

Gruß, Michael

 

Vielleicht nicht unbedingt merkwürdig, aber halt ein Firmenrechner mit sehr eingeschränkten Rechten. Ich versuche das mal zuhause auf meinem Privaten.
Trotzdem danke.

 

Aber doch wohl nicht so eingeschränkt, daß keine Makros ausgeführt werden oder? Ich meine, sonst... wäre das ja wirklich ziemlich witzlos... ;-)

Gruß, Michael