Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Code verkürzen

Betrifft: Code verkürzen von: Guesa
Geschrieben am: 05.10.2020 16:58:56

Hallo Forum
In folgender Datei tausche ich Unterschriften, was soweit auch funktioniert. Wie kann der nicht so elegante Code, anders hab ich es nicht hingekriegt, verkürzt werden.

Schon mal ein Dankeschön für eure Hilfe

Gruß, Guesa

https://www.herber.de/bbs/user/140668.xlsm

Betrifft: AW: Code verkürzen
von: Daniel
Geschrieben am: 05.10.2020 17:11:31

Hi
vielleicht nach diesem Prinzip

statt:
Sub Makro1
Debug.print "1"
End Sub

Sub Makro2
Debug.print "2"
End Sub

Sub Makro3
Debug.print "3"
End Sub
das hier
Sub HauptMakro()
x = "1" 'oder "2" oder "3"
Call UnterMakro(x)
End Sub

Sub UnterMakros(y)
Debug.Print y
End Sub
Gruß Daniel

Betrifft: AW: Code verkürzen
von: Guesa
Geschrieben am: 05.10.2020 18:41:27

Hallo Daniel
Danke für die Antwort, das wäre ja fast so wie ich es jetzt habe. Könnte über eine Schleifenabfrage gehen aber gerade bei Grafiken ist das wohl nicht so einfach da habe ich gar keine Ahnung von.

Gruß, Guesa

Betrifft: AW: Code verkürzen
von: Yal
Geschrieben am: 05.10.2020 18:36:37

Hallo Guesa,

_ beachte dein Identierung
_ verwende Variablen
_ mache Dir ein Bild, von was sich wiederholt und
_ was der eine vom anderen unterscheidet

Demtentsprechend folgende Vorschlag:
Sub U1_einfügen() 'nummer 1
Dim Wa As Worksheet
Dim Wb As Worksheet
Dim Wu As Worksheet
Dim ashp As Shape

Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="1"

    Set Wa = ActiveSheet
    Set Wb = Worksheets("Bestellung")
    For Each ashp In AW.Shapes
        Debug.Print ashp.Name
        AW.Shapes.Range(Array(ashp.Name)).Delete
        Wu.Shapes("1").Copy
        Wb.Paste
        Wb.Shapes("1").Left = 210
        Wb.Shapes("1").Top = 710
        Wb.Range("E51") = Wu.Range("B2").Value
        Wa.Range("C2").Select
        MsgBox "Die Unterschrift wird in: " & Wb.Range("E51") & " geändert!"
    Next ashp
ActiveSheet.Protect Password:="1"
Application.ScreenUpdating = True
End Sub
ungetestet.

Viel Erfolg
Yal