Makro in Befehlsschaltfläche integrieren

[Crackertracker]

Hallo Leute,

habe hier mal nen Code von VB für euch den ich in eine einfache Befehlsschaltfläche integrieren möchte. Allerdings ploppt dann im Compiler kurzerhand folgender Fehlercode auf: "Laufzeitfehler '5': Ungültiger Prozeduraufruf oder ungültiges Argument"

Code:

Private Sub CommandButton1_Click()
        Range("D10:F12").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Name = "Webdings"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("C8:C14").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("D8:G9").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("D13:G14").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("G10:G12").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("D6:F7").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("D10:F12").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 420, 107.25, 180, _
        148.5).Select
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 29).Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
        "Mit F9 Würfelzauber beginnen!"
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 29). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignCenter
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).Font
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "Arial Black"
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(7, 23).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "Arial Black"
    End With
    Range("D6:F7").Select
    ActiveCell.FormulaR1C1 = "=TRUNC(RAND()*9)+1"
    Range("D6:F7").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Size = 12
    Selection.Font.Size = 14
    Selection.Font.Size = 16
    Selection.Font.Size = 18
    Selection.Font.Size = 20
    Selection.Font.Size = 22
    Selection.Font.Size = 24
    Selection.Font.Size = 26
    Range("D10").Select
    ActiveCell.FormulaR1C1 = _
        "=CHOOSE(R[-4]C,Eins,Zwei,Drei,Vier,Fünf,Sechs,Sieben,Acht,Neun)"
    Range("D10").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D10:F12").Select
    Selection.FormulaArray = _
        "=CHOOSE(R[-4]C,Eins,Zwei,Drei,Vier,Fünf,Sechs,Sieben,Acht,Neun)"
    Range("C1:G3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection.Font
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16727809
        .TintAndShade = 0
    End With
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16727809
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    ActiveCell.FormulaR1C1 = "Würfelspaß"
    Range("C1:G3").Select
    Selection.Font.Size = 12
    Selection.Font.Size = 14
    Selection.Font.Size = 16
    Selection.Font.Size = 18
    Selection.Font.Size = 20
    Selection.Font.Size = 22
    Selection.Font.Size = 24
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("C17").Select
    ActiveCell.FormulaR1C1 = "Viel Spaß :-)"
    Range("D20").Select
End Sub

so sieht das ganze aus. Fällt euch vielleicht etwas auf?

Danke vorab!

Liebe Grüße

[RPP63]

Bei mir ploppen noch ganz andere Fehler auf!
Ehrliche Meinung:
Ein Makrorekorder kann manchmal sinnvoll sein, wenn man kurz auf die Syntax schauen will.

Egal:
Lösche folgendes:

Code:

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 29).Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With

und:

Code:

    ActiveCell.FormulaR1C1 = _
        "=CHOOSE(R[-4]C,Eins,Zwei,Drei,Vier,Fünf,Sechs,Sieben,Acht,Neun)"
    Range("D10").Select
    ActiveCell.FormulaR1C1 = ""

---

Was hast Du denn genau vor?
Willst Du eine "gewisse" Animation erreichen?

Dann würde ich eher mit sleep und Calculate arbeiten.

[Crackertracker]

Hat ohne Probleme geklappt nachdem ich das rausgenommen habe. Was war denn jetzt genau das Problem? Verstehe auch nur Teile des Codes, was sollten die rausgelöschten Stellen denn eigentlich bewirken?

/e War einfach nur zum Jucks, dass das quasi mal jemand öffnen kann und per Click dann den "Würfelzauber" hat. Sleep und Calculate sagen mir leider nichts.

Liebe Grüße

[RPP63]

Lösche den gesamten Code und füge dies ein:

Modul Modul1

Option Explicit 
 
#If VBA7 Then 
  'For 64-Bit versions of Excel 
  Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 
#Else 
  'For 32-Bit versions of Excel 
  Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
#End If 
 
Sub Wuerfeln() 
Dim i& 
For i = 1 To 10 
  ActiveSheet.Calculate 
  Sleep 200 
Next 
End Sub 

Wenn Du jetzt auf dem Blatt des Würfels einen Button einfügst und ihm das Makro Wuerfeln() zuordnest,
hast Du 10 Ziehungen im Abstand von 0,2 Sekunden hintereinander.
Und dies bei jedem Klick auf den Button.

[Crackertracker]

Mit dem Code krieg ich bei Modul1 ne Fehlermeldung s. Bild

Muss aber auch dazu sagen, mit Excel kenne ich mich schon etwas aus von VB hab ich allerdings überhaupt keine Ahnung.
Kannst du mir vielleicht ne Seite oder gute Übungsaufgaben, ggf. etwas zum einlesen empfehlen? Dafür wäre ich ebenfalls sehr dankbar.

LG

[Kuwer]

Hi Ralf,

#If VBA7 Then
  'For 64-Bit versions of Excel

bist Du Dir da ganz sicher?

Gruß Uwe

[RPP63]

Nö!
Ich hatte das der Einfachkeit halber von einer Seite kopiert, weil ich nicht suchen wollte, in welcher meiner Dateien ich das nutze.
Betrifft natürlich 64-Bit OS.
Habs leider nicht gegen gelesen.

Nevertheless kann ich den Fehler nicht nachvollziehen, läuft bei mir einwandfrei.

Ich habe in meiner 365-Spielkiste die Würfelei mal auf ein aktuelles Excel umgestellt.
Wählt zufällig zwischen 10 und 15 Vorgängen:
Modul Modul1

Option Explicit 
 
#If VBA7 Then 
  Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 
#Else 
  Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
#End If 
 
Sub Wuerfeln() 
' nur für Excel 365 
Dim arr, i& 
arr = WorksheetFunction.RandArray _
  (WorksheetFunction.RandBetween(10, 15), , 1, 6, 1) 
For i = 1 To Ubound(arr) 
  Range("J3") = arr(i, 1) 
  Sleep 300 
Next 
End Sub 

[Kuwer]

Hi Ralf,

VBA7 steht für Office 2010 oder höher.
Das sollte mit dem Fehler beim TE aber nichts zu tun haben, eher vielleicht jedoch die Tatsache, dass der Code in der persönlichen Makroarbeitsmappe steht?

Gruß Uwe

[RPP63]

Mit dem API-Gedöns habe ich nix am Hut und verwende es auch ausschließlich in privaten Spielereien.
Schließlich kann man nie wissen, ob sich sonst ein "fauler Apfel" einschleicht.

Aber: Danke für die Berichtigung!

[Crackertracker]

Danke nochmal für den Code, ihr scheint ja beide ziemlich fortgeschritten zu sein. Könnt ihr mir vielleicht etwas für den soften Start empfehlen?
Hab vor ein paar Jahren ein wenig mit C++ herumgespielt und hab zumindest ein wenig Verständnis in Sachen scripten. Ich schau mich zudem mal näher hier im Forum um dort wird wahrscheinlich auch einiges nützliches für Anfänger zu finden sein.