Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
676to680
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
676to680
676to680
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Shapes kopieren

Shapes kopieren
03.10.2005 20:49:05
Wolfgang
Hallo,
ich habe ein Makro gefunden, dass bei Rechtsklick in eine Zelle ein X setzt und bei nochmaligen Rechtsklick in selber Zelle das X wieder löscht.
Jetzt wollte ich das Makro so umbauen, dass statt dem X eine Grafik (oder Bild)
eingefügt wird. Leider schreibt mir das Makro jetzt 2 mal das Bild in die Tabelle (an verschiedenen Stellen) und reagiert auch nicht, wenn ich das Bild wieder löschen will.
Würde mich sehr über eine Lösung freuen.
Gruß
Wolfgang

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Intersect(Target, Range("A1:BF55")) Is Nothing Then
ActiveSheet.Shapes("Picture 12").Copy
Cancel = True
Target.Value = IIf(Target.Value = ActiveSheet.Paste, "", ActiveSheet.Paste)
End If
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Shapes kopieren
04.10.2005 00:14:58
Nepumuk
Hallo Wolfgang,
ein Shape und ein X sind zwei paar Stiefel:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim objShape As Shape
    Dim blnFound As Boolean
    If Not Intersect(Target, Range("A1:BF55")) Is Nothing Then
        For Each objShape In Me.Shapes
            With objShape.TopLeftCell
                If .Row = Target.Row And .Column = Target.Column Then blnFound = True: Exit For
            End With
        Next
        If blnFound Then
            objShape.Delete
        Else
            Me.Shapes("Picture 12").Copy
            Me.Paste
            Target.Select
        End If
        Cancel = True
    End If
End Sub
Gruß
Nepumuk
Anzeige
AW: Shapes kopieren
04.10.2005 09:35:53
Wolfgang
Hallo Nepumuk,
vielen Dank für Deine Antwort.
Dein Makro klappt auch wunderbar, leider kann ich zum Löschen des Bildes mit Rechtsklick
die entsrechende Zelle nicht so einfach anklicken. Das Bild was eingefügt wurde ist gleich groß wie die Zelle, Ich klicke also nicht die Zelle an sondern das Bild und dann wird es nicht gelöscht, es erscheint ein Menü.
Ist es möglich, bei Rechtsklick auf das Bild (nicht die Zelle)es sofort zu löschen?
Gruß
Wolfgang
AW: Shapes kopieren
04.10.2005 10:41:38
Nepumuk
Hallo Wolfgang,
den Rechtsklick auf ein Shape kann ich nicht auswerten. Aber wenn diesem ein Makro zugewiesen wird, dann kann es mit einem Linksklick gelöscht werden.
Beispiel:
' **********************************************************************
' Modul: Tabelle2 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim objShape As Shape
    Dim blnFound As Boolean
    If Not Intersect(Target, Range("A1:BF55")) Is Nothing Then
        Me.Shapes("Picture 12").Copy
        Me.Paste
        Target.Select
        For Each objShape In Me.Shapes
            With objShape.TopLeftCell
                If .Row = Target.Row And .Column = Target.Column Then
                    objShape.Name = ObjPtr(objShape)
                    objShape.OnAction = "prcDeleteShape"
                    Exit For
                End If
            End With
        Next
        Cancel = True
    End If
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub prcDeleteShape()
    ActiveSheet.Shapes(Application.Caller).Delete
End Sub
Gruß
Nepumuk
Anzeige
AW: Shapes kopieren
04.10.2005 11:23:09
Wolfgang
Hallo Nepumuk,
vielen Dank für Deine Mühe, werde es so machen.
Gruß
Wolfgang

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige