Shapes kopieren

Forumthread: 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

AW: Shapes kopieren

04.10.2005 00:14:58

Nepumuk
AW: Shapes kopieren

04.10.2005 09:35:53

Wolfgang
AW: Shapes kopieren

04.10.2005 10:41:38

Nepumuk
AW: Shapes kopieren

04.10.2005 11:23:09

Wolfgang

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

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

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)

Forumthread: Shapes kopieren

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread