Schaltfläche per Makro erzeugen

Hallo
Folgendes: Gegeben sei eine X- und eine Y-Koordinate (z. B. kox = 3, koy = 5, das wäre die Zelle C5) Das könnte an einer bestimmten Stelle als Zelleninhalt stehen oder auch (als Variable?) aus einem anderen Makro kommen.
Innerhalb dieser Zelle soll mir ein Makro eine Schaltfläche erzeugen
Größe der Schaltfläche wäre idealer Weise ein Kreis 10 % kleiner wie die Zelle (x-Ausdehnung) oder auch gleich wie die Zelle, wenn das aber aufwändig ist auch eine feste Größe als Kreis.
Die nächste Herausforderung wäre dann, dass ein Klick auf diese Schaltfläche (von denen ich mehrere erzeugen will) wiederum die Koordinaten dieser Zelle irgendwo hin schreibt oder an einen anderen Makro übergibt.
Geht sowas? und wenn Ja würde mich natürlich interessieren wie...
Vielen Dank schon mal
Grüßle Claus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Claus,
wofür das wohl wieder gut sein soll ;-))

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub test()
  Dim lngX As Long, lngY As Long
  
  lngY = 3
  lngX = 5
  
  With Cells(lngX, lngY)
    prcAddShape .Left + .Width * 0.05, .Top + .Height * 0.05, .Width * 0.9, "'theAction ""Zeile - " & .Row & vbLf & "Spalte - " & .Column & """'"
  End With
End Sub


Sub test2()
  Dim lngRow As Long, lngCol As Long
  
  With ActiveSheet
    .Shapes.SelectAll
    Selection.Delete
    For lngRow = 1 To 10
      For lngCol = 1 To 10
        With .Cells(lngRow, lngCol)
          prcAddShape .Left + .Width * 0.05, .Top + .Height * 0.05, .Width * 0.9, "'theAction ""Zeile - " & .Row & vbLf & "Spalte - " & .Column & """'"
        End With
      Next
    Next
  End With
  
End Sub


Sub prcAddShape(x_ As Double, y_ As Double, size_ As Double, OnACtion_ As String)
  Dim objShp As Shape
  
  Set objShp = ActiveSheet.Shapes.AddShape(msoShapeOval, x_, y_, size_, size_)
  
  With objShp
    .Fill.ForeColor.RGB = vbYellow
    .Line.ForeColor.RGB = vbRed
    .Line.Weight = 1
    .OnAction = OnACtion_
    End With
  
  Set objShp = Nothing
End Sub


Sub theAction(Message As String)
  MsgBox Message
End Sub

« Gruß Sepp »

' ********************************************************************** ' Modul: Modul1 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Sub test() Dim lngX As Long, lngY As Long lngY = 3 lngX = 5 With Cells(lngX, lngY) prcAddShape .Left + .Width * 0.05, .Top + .Height * 0.05, .Width * 0.9, "theAction" End With End Sub Sub prcAddShape(x_ As Double, y_ As Double, size_ As Double, OnACtion_ As String) Dim objShp As Shape Set objShp = ActiveSheet.Shapes.AddShape(msoShapeOval, x_, y_, size_, size_) With objShp .Fill.ForeColor.RGB = vbYellow .Line.ForeColor.RGB = vbRed .Line.Weight = 1 .OnAction = OnACtion_ End With Set objShp = Nothing End Sub Sub theAction() With ActiveSheet.Shapes(Application.Caller) Cells(1, 1) = .TopLeftCell.Row Cells(1, 2) = .TopLeftCell.Column End With End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Schaltfläche per Makro erzeugen

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread