Office: WENN Makro

Helfe beim Thema WENN Makro in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo liebes Forum, ich versuche über meine WENN Abfrage ein Makro (eine Funktion) zu starten =WENN(H2"";ellipse();"") Meine extra-komplizierte... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von falko_d, 25. Oktober 2020.

Seite 1 von 3

FALKO_D

falko_d

WENN Makro

Hallo liebes Forum,

ich versuche über meine WENN Abfrage ein Makro (eine Funktion) zu starten
=WENN(H2"";ellipse();"")

Meine extra-komplizierte Funktion, die aufgerufen werden soll:

Code:

Function ellipse()

ellipse_woanders_einfügen

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

und der Code, der daraufhin einen hübschen Kringel um 5 Spalten nach links versetzt einfügen soll:

Code:

Sub ellipse_woanders_einfügen()
Dim Länge%, Höhe%, ellipse
Länge = 14
Höhe = 14
Value = 5
Selection.Offset(0, -Value).Select
Set ellipse = ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left - Länge / 2, ActiveCell.Top + (ActiveCell.Height - Höhe) / 2, Länge, Höhe)
ellipse.Fill.Visible = msoTrue
ellipse.Fill.ForeColor.RGB = RGB(248, 248, 248)
ellipse.Line.ForeColor.RGB = RGB(0, 90, 175)
ellipse.Line.Weight = 4
Selection.Offset(0, Value).Select
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das Makro ansich funktioniert. Bekomme einen versetzten Kringel per Mausklick.

Über WENN und die Zusatzfunktion bekomme ich zwar auch einen Kringel, doch nicht versetzt. Was übersehe ich? Nimmt er den falschen Zellenbezug als ActiveCell und springt deshalb nicht? Er zeigt auch "0" an obwohl ich das nicht absichtlich programmiert habe *Smilie

Anbei das Beispiel.

Vielen Dank für die Hilfe!

Liebe Grüße
Falko

:)

falko_d, 25. Oktober 2020

#1
Beverly Erfahrener User

Hi Falko,

ergänze diese Zeile:

Code:

ellipse.Left = Selection.Offset(0, -Value).Left
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und die beiden Zeilen mit Selection.Offset(0, -Value).Select kannst du weglassen, denn sie bewirken in einer Function nichts.

Beverly, 27. Oktober 2020

#2
FALKO_D

falko_d

Hallo Karin,
Danke für deinen Tip!

Mit der Zeile springt leider der Debugger an und markiert sie mir.

Folgendes habe ich nun versucht zu starten:
Code:

Sub ellipse_woanders_einfügen()
Dim Länge%, Höhe%, ellipse
Länge = 14
Höhe = 14
Value = 20
ellipse.Left = Selection.Offset(0, -Value).Left
Set ellipse = ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left - Länge / 2, ActiveCell.Top + (ActiveCell.Height - Höhe) / 2, Länge, Höhe)
ellipse.Fill.Visible = msoTrue
ellipse.Fill.ForeColor.RGB = RGB(248, 248, 248)
ellipse.Line.ForeColor.RGB = RGB(0, 90, 175)
ellipse.Line.Weight = 4
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Klappt leider nicht. Aber ich glaube wir sind nah dran! *biggrin.gif*

falko_d, 29. Oktober 2020

#3
WS-53

WS-53

WENN Makro

Hallo Falko,

du hast noch eine offene Baustelle, zu der eine Rückmeldung fehlt !!!

WS-53, 29. Oktober 2020

#4
FALKO_D

falko_d

Hoppla, danke! Die Email Benachrichtigungen funktionieren nicht mehr...

falko_d, 29. Oktober 2020

#5
EARLFRED

EarlFred

Was aus deiner Frage überhaupt nicht hervorgeht: Relativ zu welcher Zelle soll denn der "Kringel" eingefügt werden? Relativ zu der Zelle, in der deine Formel steht oder relativ zu der Zelle H2?

Nachfolgend wird relativ zur Zelle mit der Formel eingefügt:
Code:

Option Explicit

'Aufruf aus anderem Code, z. B. mittels Button:
'Sub start()
'Call ellipse_woanders_einfügen
'End Sub

Function ellipse()
If TypeName(Application.Caller) = "Range" Then
Call ellipse_woanders_einfügen(rngBezug:=Application.Caller)
ellipse = "Kringel gemalt"
Else
ellipse = "kein Kringel"
End If

End Function

Sub ellipse_woanders_einfügen(Optional ByRef rngBezug As Range)
Dim Länge As Integer
Dim Höhe As Integer
Dim Spaltenversatz As Long

Dim rngAnker As Range

Länge = 14
Höhe = 14
Spaltenversatz = 5

If rngBezug Is Nothing Then Set rngBezug = ActiveCell
Set rngAnker = rngBezug.Offset(, -Spaltenversatz)
With ActiveSheet.Shapes.AddShape( _
Type:=msoShapeOval, _
Left:=rngAnker.Left - Länge / 2, _
Top:=rngAnker.Top + (rngAnker.Height - Höhe) / 2, _
Width:=Länge, _
Height:=Höhe)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(248, 248, 248)
.Line.ForeColor.RGB = RGB(0, 90, 175)
.Line.Weight = 4
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bitte nutze Option Explicit.

Er zeigt auch "0" an obwohl ich das nicht absichtlich programmiert habe
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Du solltest aber etwas vorgeben: den Rückgabewert deiner Function (sonst ist er eben 0) und den Typ des Rückgabewerts. Den Rückgabewert habe ich mal demonstriert, den Typ passend zum von dir gewollten Rückgabewert vorzugeben schaffst du sicher.

EarlFred, 29. Oktober 2020

#6
Beverly Erfahrener User

Hi Falko,

wenn du die Zeile VOR dem Erstellen des Shapes einfügst, KANN das natürlich nicht funktionieren und ergibt einen Fehler, denn sie ist ja noch gar nicht da, also der Variablen "ellipse" wurde noch gar kein Objekt zugewiesen... Die Codezeile muss also auf jeden Fall NACH der Zeile Set ellipse = ... stehen.

Beverly, 29. Oktober 2020

#7
FALKO_D

falko_d

WENN Makro

Hallo Karin,

vielen Dank. So einfach kann es natürlich gehen *tongue.gif*

Ich würde nun gerne "Value" (in ellipse_woanders_einfügen() als den geänderten Zellenwert definieren. Sagen wir unter "Wert bitte" steht 2, dann soll der Kringel zwei nach links verschoben eingefügt werden. Wenn dort steht 7, dann entsprechend um 7 Spalten nach links verschoben. Ich weiß nur leider nicht, wie ich das programmieren kann, ohne eine gezielte Zelle zu wählen, da ich die =WENN Funktion gerne in verschiedenen Zeilen mit dem selben Makro ansteuern würde.
Sodass ich z.B. über 10 Zeilen verteilt Kringel über mein Makro erstelle, indem ich nur in der jeweiligen Zeile unter "Wert bitte" eine Zahl eintrage.

Danke vielmals für eure Hilfe!

Falko

falko_d, 1. November 2020

#8
FALKO_D

falko_d

Und zack, gelöst.

Value = ActiveCell.Value

Da ich ja immer in der entsprechenden Zelle stecke, wenn ich sie ändere.

JUCHEE! Vielen Dank!

Und lieben Gruß
Falko

falko_d, 1. November 2020

#9
FALKO_D

falko_d

Hallo,

komischerweise fügt mein Makro manchmal wie gewünscht eine, manchmal jedoch mehrere (in der Regel 6) Ellipsen ein.

Weiß jemand, woran das liegt und wie ich das beheben kann?

Benutze noch immer das hier, aktiviert über =WENN und eine Funktion

Code:

Sub ellipse_woanders_einfügen()

Dim Länge%, Höhe%, ellipse
Länge = 14
Höhe = 14
Value = ActiveCell.Value
Set ellipse = ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left, ActiveCell.Top + (Höhe / 3), Länge, Höhe)
ellipse.Left = Selection.Offset(0, -(72 - (Value * 4))).Left - (Länge / 2)
ellipse.Fill.Visible = msoTrue
ellipse.Fill.ForeColor.RGB = RGB(248, 248, 248)
ellipse.Line.ForeColor.RGB = RGB(0, 90, 175)
ellipse.Line.Weight = 4

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vielen Dank für eure Hilfe

Liebe Grüße
Falko

falko_d, 11. November 2020

#10
EARLFRED

EarlFred

Anstelle dieses fehleranfälligen Konstrukts aus Formel, Makro, Activecell- und Selection-Gewurschtel nutze besser das Change-Ereignis - das erfüllt das Vorhaben deutlich zuverlässiger:
Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Eingabebereich
Dim rngEingabebereich As Range
Dim rngAktuell As Range

'Anpassen!
Set rngEingabebereich = Me.Range("AG2:AG100")

If Not Intersect(Target, rngEingabebereich) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereich)
Call ellipse_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If
End Sub

Sub ellipse_woanders_einfügen(ByRef rngAnker As Range)

Dim Versatz As Long
Dim Breite As Single
Dim Höhe As Single
Dim ellipse As Shape

If LöscheAlteEllipse(rngAnker:=rngAnker) Then

Versatz = -(72 - (rngAnker.value * 4))
Höhe = 14
Breite = 14

If rngAnker.Column + Versatz > 0 Then

Set ellipse = rngAnker.Worksheet.Shapes.AddShape( _
Type:=msoShapeOval, _
Left:=Application.Max(rngAnker.Offset(0, Versatz).Left - (Breite / 2), 0), _
Top:=rngAnker.Top + (Höhe / 3), _
Width:=Breite, _
Height:=Höhe)

With ellipse
.Name = "ell!" & rngAnker.Address
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(248, 248, 248)
.Line.ForeColor.RGB = RGB(0, 90, 175)
.Line.Weight = 4
End With

End If
End If
End Sub

Function LöscheAlteEllipse(ByRef rngAnker As Range) As Boolean
On Error Resume Next
rngAnker.Worksheet.Shapes("ell!" & rngAnker.Address).Delete
On Error GoTo 0

LöscheAlteEllipse = Err = 0
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Code gehört in das Modul des Worksheets, in dem du die Eingaben überwachen willst. Den zu überwachenden Bereich (im Beispiel willkürlich auf AG2:AG100 gesetzt) musst du freilich anpassen.
Der Code räumt alte, nicht mehr benötigte Ellipsen auch wieder auf - im Gegensatz zu deinem Code, der einfach neue ins Blatt kleistert.

EarlFred, 12. November 2020

#11
FALKO_D

falko_d

Hallo EarlFred,

das ist ein klasse Code! Funktioniert einwandfrei *Smilie Vielen Dank für die Mühe! Ich glaube ich verstehe sogar fast die Hälfte!

Um nun einige Zeilen drunter in einem Abschnitt Vierecke einzufügen habe ich den Code umgestellt:

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Eingabebereich
Dim rngEingabebereich As Range
Dim rngAktuell As Range

'Anpassen!
Set rngEingabebereich = Me.Range("CF117:CF121")

If Not Intersect(Target, rngEingabebereich) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereich)
Call viereck_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If
End Sub

Sub viereck_woanders_einfügen(ByRef rngAnker As Range)

Dim Versatz As Long
Dim Breite As Single
Dim Höhe As Single
Dim viereck As Shape

If LöscheAltesViereck(rngAnker:=rngAnker) Then

Versatz = -(72 - (rngAnker.Value * 4))
Höhe = 9
Breite = 9

If rngAnker.Column + Versatz > 0 Then

Set viereck = rngAnker.Worksheet.Shapes.AddShape( _
Type:=msoShapeRectangle, _
Left:=Application.Max(rngAnker.Offset(0, Versatz).Left - 4, 0), _
Top:=rngAnker.Top + 6, _
Width:=Breite, _
Height:=Höhe)

With viereck
.Name = "vier!" & rngAnker.Address
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(248, 248, 248)
.Line.ForeColor.RGB = RGB(0, 90, 175)
.Line.Weight = 4.5
.Rotation = 45
End With

End If
End If
End Sub

Function LöscheAltesViereck(ByRef rngAnker As Range) As Boolean
On Error Resume Next
rngAnker.Worksheet.Shapes("vier!" & rngAnker.Address).Delete
On Error GoTo 0

LöscheAltesViereck = Err = 0
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Auch der funktioniert einwandfrei. Anderer Bereich, andere Form, alles super. Für Dreiecke hat es auch schon geklappt.

Was ich nun nicht verstehe ist, wie ich den Code einarbeiten muss, sodass ich sowohl die Ellipsen von Zeile 93-98, Dreiecke 103-112 und Vierecke 117-121 eingefügt werden. (Diese Bereiche ändern sich auch oft)
Geht das in einem Modul? Oder wie löse ich das am geschicktesten?

Vielen lieben Dank für die Hilfe!

Gruß
Falko

falko_d, 16. November 2020

#12
FALKO_D

falko_d

WENN Makro

Da fällt mir ein: wenn ich Spalten lösche muss ich das entsprechend auch im Code anpassen. Das ist kein großes Problem, ich frage mich nur, ob das evtl einfacher geht. Den Eingabebereich und den Versatz 72 muss ich ändern.

LG
Falko

falko_d, 16. November 2020

#13
EARLFRED

EarlFred

sowohl die Ellipsen von Zeile 93-98, Dreiecke 103-112 und Vierecke 117-121 eingefügt werden
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Eingabebereich
Dim rngEingabebereichElli As Range
Dim rngEingabebereichDrei As Range
Dim rngEingabebereichVier As Range
Dim rngAktuell As Range

'Anpassen!
Set rngEingabebereichElli = Me.Range("CF117:CF121")
Set rngEingabebereichDrei = Me.Range("CF190:CF222")
Set rngEingabebereichVier = Me.Range("CF333:CF444")

If Not Intersect(Target, rngEingabebereichElli) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereichElli)
Call ellipse_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If

If Not Intersect(Target, rngEingabebereichDrei) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereichDrei)
Call dreiiecke_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If

If Not Intersect(Target, rngEingabebereichVier) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereichVier)
Call viereck_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Man könnte die Prozedur für die Formen vereinheitlichen (eine Prozedur mit Übergabeparameter für die unterschiedlichen Formen). Das wäre eine gute Übung.

Spalten einfügen / löschen: Schau dir die Möglichkeit von benannten Bereichen an.

EarlFred, 17. November 2020

#14
FALKO_D

falko_d

Ah das klingt super. Dann nehme ich noch Named Range mit rein, dann sollte es so klappen, wie ich es mir vorstelle.

Vielen Dank!

falko_d, 22. November 2020

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 3

Thema:

WENN Makro

Die Seite wird geladen...

WENN Makro - Similar Threads - Makro
Makro Zip-Datei von Webseite runterladen, auspacken, kopieren
in Microsoft Excel Hilfe
Makro Zip-Datei von Webseite runterladen, auspacken, kopieren: Hallo Zusammen, ich habe ein Makro gefunden von dem ich denke, dass es koennen sollte was ich braeuchte, eine Datei herunterladen, auspacken und den Inhalt in die Datei kopieren in der das Makro...
Makro für variable Anzahl von Datensätzen
in Microsoft Excel Hilfe
Makro für variable Anzahl von Datensätzen: Hallo zusammen, ich habe wieder einmal ein kleines Excel-Problem, bei dem Ihr mir sicherlich helfen könnt. Ich habe eine Excel-Liste, das ist ein Export aus einem anderen Programm (siehe...
Makro aus personal.xls starten
in Microsoft Excel Hilfe
Makro aus personal.xls starten: Auf einem Arbeitsblatt habe ich mehrere Buttons. Die zugehörigen Makros sind in personal.xls gespeichert. Aus dem Code-Editor heraus kann ich die Makros ohne Problem starten. auf dem Arbeitsblatt...
Dokumente und Blatt umbenennen
in Microsoft Word Hilfe
Dokumente und Blatt umbenennen: Ich lade mir jeden Tag csv-Dateien von meiner Bank herunter. Diese sind mit Datum versehen, also die Datei selbst und das erste Blatt, z.B. "Konto_13.02.2024". Wenn ich ein Makro erstelle, in dem...
Speichern mit dem Titel der Zelle A2
in Microsoft Excel Hilfe
Speichern mit dem Titel der Zelle A2: Moin moin, Ich habe per Makro einen Arbeitsablauf aufgezeichnet der soweit auch funktioniert. Dieser Endet jedoch im "Speichern Unter" Fenster, welches durch das Klicken von "Drucken als PDF"...
Barcode Scanliste Makro anpassen
in Microsoft Excel Hilfe
Barcode Scanliste Makro anpassen: Hallo zusammen! Einer der Mitglieder hier hat mir eine Funktionsliste erstellt, mit der man Barcodes scannt und danach einen Wert über die Bildschirmtastatur eingibt. Die Barcodes hatten bisher...
Makro wird nicht angezeigt im Makro Auswahlfenster
in Microsoft Excel Hilfe
Makro wird nicht angezeigt im Makro Auswahlfenster: Hallo, wenn ich mein Makro ausführen möchte, öffnet sich das Makro Auswahlfenster. Allerdings wird das Makro nicht aufgelistet. Das Makro befindet sich in der PERSONAL.xlsb Arbeitsmappe. Die...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden