Anzeige
Archiv - Navigation
1504to1508
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
Inhaltsverzeichnis

Makros zu einem Makro ändern

Makros zu einem Makro ändern
23.07.2016 12:16:44
Dieter(Drummer)
Guten Tag, VBA Spezialisten,
wie muss das Makro sein, wenn aus mehreren Makros ein Makro gemacht wird?
Wäre schön, wenn mir da geholfen werden könnte. Anbei meine Datei mit den bisherigen Makros.
Mit Gruß,
Dieter(Drummer)
https://www.herber.de/bbs/user/107184.xlsm

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makros zu einem Makro ändern
23.07.2016 12:53:03
Hajo_Zi
Hallo Dieter,
ich bin nun nicht der Fachmann für Formular Steuerelemente.
Trage bei AternativeText die Nummer ein und benutze nur ein Makro.
Sub farbe_gruen()
Dim objSpeaker As Object, x&
Set objSpeaker = CreateObject("SAPI.SpVoice")
objSpeaker.Volume = 100
For x = 5 To 5
objSpeaker.Speak Range("BA" & x)
Next
ActiveSheet.Unprotect
With Selection.Interior
.ColorIndex = ActiveSheet.Shapes(Application.Caller).AlternativeText
End With
ActiveSheet.Protect
End Sub

AW: Makros zu einem Makro ändern
23.07.2016 13:15:18
Dieter(Drummer)
Danke Hajo. für Rückmeldung, Makroänderung und Hinweis. Könntest du mir da ein Beisiel gegen, da ich nicht weiß, wie ich das umsetzen soll.
Gruß, Dieter(Drummer)
Anzeige
AW: Makros zu einem Makro ändern
23.07.2016 13:20:20
Hajo_Zi
Hallo Dieter,
allen Schalter diese Makro zuweisen und bei AlternativenText die Zahl eintragen.
Wo ist das Problem?
Ich speichere keine Dateien aus dem Herber Forum. Da kein richtiger Name.
Gruß Hajo
AW: Makros zu einem Makro ändern
23.07.2016 13:39:38
Dieter(Drummer)
Hallo Hajo, danke für Hinweis. Ich habe jetzt allen Farbbuttons dein geändertes Makro zugewiesen.
Mit der Angabe der Zahl bei Alternativen Text, verstehe ich noch nicht und bitte weiter um Hilfe. Meine Datei nochmal als Anhang.
Gruß, Dieter(Drummer)
Hier dein Makro:
'Herber: von Hajo_Zi am 23.07.2016
Sub farbe_diverse()
Dim objSpeaker As Object, x&
Set objSpeaker = CreateObject("SAPI.SpVoice")
objSpeaker.Volume = 100
For x = 5 To 5
objSpeaker.Speak Range("BA" & x)
Next
ActiveSheet.Unprotect
With Selection.Interior
.ColorIndex = ActiveSheet.Shapes(Application.Caller).AlternativeText
End With
ActiveSheet.Protect
End Sub

https://www.herber.de/bbs/user/107185.xlsm
Anzeige
AW: Makros zu einem Makro ändern
23.07.2016 13:42:30
Hajo_Zi
in der Zeile
.ColorIndex = ActiveSheet.Shapes(Application.Caller).AlternativeText
wird die Nummer ausgelesen und zugewiesen.
Ich sehe keinen Grund eine Datei herrunter zuladen.

AW: Danke Hajo für Hilfe ...
23.07.2016 13:45:05
Dieter(Drummer)
... ich werde weiter probieren, bis ich es schaffe.
Gruß, Dieter(DRummer)
AW: Makros zu einem Makro ändern
23.07.2016 23:47:57
DD
Moin Dieter(Drummer),
mich hat dein "Problem" auch interessiert.
Bei mir läuft das mit dem unten eingefügten Code.
Es war mir noch aufgefallen, dass in deiner Datei die beiden
rechten Shapes die gleiche Bezeichnung "Rectangle 6" haben.
Das produziert jeweils die gleiche Füllfarbe.
Gruß Dieter_D
Sub farbe_diverse()
Dim objSpeaker As Object, x&
Set objSpeaker = CreateObject("SAPI.SpVoice")
objSpeaker.Volume = 100
For x = 5 To 5
objSpeaker.Speak Range("BA" & x)
Next
ActiveSheet.Unprotect
With Selection.Interior
.Color = ActiveSheet.Shapes(Application.Caller).Fill.ForeColor  '.AlternativeText
End With
ActiveSheet.Protect
End Sub

Anzeige
AW: Makros zu einem Makro ändern
24.07.2016 00:09:44
Matthias
Hallo Dieter & Dieter ;-)
Nicht ganz, denn es wird immer der Text zurückgegeben
"Aktive Zelle gleich grün"
Auch dem muss man Rechnung tragen!
Das mit dem doppelten Namen hatte ich auch schon bemerkt und war anscheinend zur selben Zeit
dabei etwas zurecht zu basteln.
Hier meine Version mit Hajos Idee
Option Explicit
Sub farbe_Shapes()
Dim objSpeaker As Object, x&
Set objSpeaker = CreateObject("SAPI.SpVoice")
objSpeaker.Volume = 100
Select Case ActiveSheet.Shapes(Application.Caller).AlternativeText
Case Is = 6 'gelb
x = 4 'Zelle("F4")
Case Is = 3 'rot
x = 3 'Zelle("F3")
Case Is = 4 'grün
x = 5 'Zelle("F5")
Case Is = 5 'blau
x = 6 'Zelle("F6")
Case Is = 15 'grau
x = 7 'Zelle("F7")
Case Is = -4142
x = 8 'Zelle("F8")
Case Is = False 'Farbknopftext
x = 9 'Zelle("F9")
End Select
objSpeaker.Speak Range("F" & x)
ActiveSheet.Unprotect
With Selection.Interior
.ColorIndex = ActiveSheet.Shapes(Application.Caller).AlternativeText
End With
ActiveSheet.Protect
End Sub
Hier die Datei:
https://www.herber.de/bbs/user/107199.xlsm
Gruß Matthias
Anzeige
AW: Danke Matthias ...
24.07.2016 08:25:02
Dieter(Drummer)
... Code läuft perfekt.
Gruß, Dieter(Drummer)
AW: Danke Dieter_D ...
24.07.2016 08:20:49
Dieter(Drummer)
... das war mir nicht aufgefallen. Danke für deinen Code.
Gruß, Dieter(Drummer)

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige