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
Access Datei wird per Makro nicht gespeichert
in Microsoft Access Hilfe
Access Datei wird per Makro nicht gespeichert: Hallo zusammen, anbei mein Makro: Private Sub Speichern_Click() Dim Dateiname As String Dim Kuerzel Kuerzel = DLookup("mitarbeiterkürzel", "tbl_mitarbeiter", "mitarbeiterid = " &...
Auswertung aus mehreren Registern erstellen (nur die Gelbmarkierten oder mit Datum von akt. Woche)
in Microsoft Excel Hilfe
Auswertung aus mehreren Registern erstellen (nur die Gelbmarkierten oder mit Datum von akt. Woche): Hallo zusammen, ich arbeite mit einer Excel-Arbeitsmappe, die mehrere Tabellenblätter enthält. Jedes Blatt dokumentiert bestimmte Vorgänge, und die Struktur der Daten ist in allen Blättern...
Name der Datei durch Excel geändert
in Microsoft Excel Hilfe
Name der Datei durch Excel geändert: Hallo und guten Abend, Die Datei wird mittels Button (VBA) zwischen gesichert. Das Makro sichert zuvor die Datei und erstellt zus. eine Sicherungsdatei mit der Erweiterung Beispiel-"Sich"....
Ein Makro für mehrere Register
in Microsoft Excel Hilfe
Ein Makro für mehrere Register: Moin, ich habe ein Makro wo Daten aus dem Register Master kopiert werden und Register, das mit einem Datum beschriftet ist. Ich möchte in Jedem Register ein Button haben was Daten aus dem Master...
Makro öffnet unerwartete Datei
in Microsoft Excel Hilfe
Makro öffnet unerwartete Datei: Hallo Forum, ich brächte euer Schwarmwissen. Arbeite mit Excel eine Auftragsbearbeitung. Dort habe ich mir einen Button mit Makro erstellt und nutze diesen schon lange. Das Makro generiert ein...
Leerzeilen entfernen
in Microsoft Word Hilfe
Leerzeilen entfernen: Hallo in die Runde, ich habe das Problem bzw. den Wunsch in einem DOC die Leerzeilen zu entfernen und das per Makro. Allerdings gelingt es nicht Hintergrund das DOC wird aus einer Dot-Datei...
Makro Schaltflaechen vervielfaeltigen sich....
in Microsoft Excel Hilfe
Makro Schaltflaechen vervielfaeltigen sich....: Hallo Zusammen, ich habe eine Exceldatei, die seit ein paar Wochen sehr langsam zu öffnen und zu bearbeiten ist. Zuvor war sie ca. 8MB gross, was sich verdoppelt hat. Ich habe alle Zellen 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