Microsoft Excel – die besten Beiträge

Excel Russisch Roulett?

Ich hab mich an Russische Roulett gewagt...
Und dabei folgendes asuprobiert

Der Schieß Button ist mit folgendem Macro verknüpft:

Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)


Sub Drehung()
'
' Drehung Makro
'

'

Dim i As Integer
Dim z As Integer

Range("C100").Select
Selection.ClearContents

i = 0
z = Cells(1, 1)

'Schnelles Drehen
Do Until i = 100
i = i + 1


   ActiveSheet.ChartObjects("Diagramm 2").Activate
   ActiveChart.FullSeriesCollection(1).Select
   ActiveChart.ChartGroups(1).FirstSliceAngle = z
   Range("R22").Select

   If z < 355 Then
   z = z + 5

   Else
   z = 0

   End If
   Application.Calculate
   Sleep (6)
   DoEvents
   DoEvents

   Loop

'Langsames Drehen
Do Until i = 165
i = i + 1


   ActiveSheet.ChartObjects("Diagramm 2").Activate
   ActiveChart.FullSeriesCollection(1).Select
   ActiveChart.ChartGroups(1).FirstSliceAngle = z
   Range("R22").Select

   If z < 358 Then
   z = z + 2

   Else
   z = 0

   End If
   Application.Calculate
   Sleep (6)
   DoEvents
   DoEvents

   Loop


End Sub

Und nun zu meiner Frage ist es irgendwie möglich die Grad in den das Diagramm2 (also die "Trommel" | Kreis ) zeigt mit einer Formel anzuzeigen.

Ich brauch dies um zu wissen ob der Spieler dann stirbt oder nicht.
(Andere Vorschläge wie es zu ermöglichen ist , sind offen )

Danke für eure Hilfe im Vorraus!!

Bild zum Beitrag
Microsoft Excel

VBA Laufzeitfehler/ Error/ Programm hängt sich auf?

Hallo zusammen,

Ich habe ein Makro geschrieben, mit welchem jeweils via Button eine neue Spalte eingefügt wird.

Über den Button Spalten entfernen wird die jeweils ausgewählte Spalte gelöscht.

Private Sub CmdSpaltePlus_Click() 'Test Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "Perfektion"

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

 

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

 

Private Sub CmdPerfektionPlus_Click() 'Perfektion Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "F.n.B."

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

Spalten löschen

Private Sub Kompetenzenentfernen_Click() 'Spalten löschen

ActiveSheet.Unprotect Password:="MNPS"

If Cells(5, ActiveCell.Column) = "Schicht" Or Cells(5, ActiveCell.Column) = "Nr." Or Cells(5, ActiveCell.Column) = "Name" Or Cells(3, ActiveCell.Column) = "A1" Or Cells(3, ActiveCell.Column) = "D1" Or Cells(9, ActiveCell.Column) = "." Or Cells(3, ActiveCell.Column) = "E1" Or Cells(3, ActiveCell.Column) = "F1" Or Cells(3, ActiveCell.Column) = "G1" Or Cells(3, ActiveCell.Column) = "H1" Or Cells(2, ActiveCell.Column) = "." Or Cells(1, ActiveCell.Column) = "Zielwert" Then

MsgBox "Spalte kann nicht gelöscht werden"

Else

Selection.EntireColumn.Delete Shift:=xlUp

End If

'ActiveSheet.Protect Password:="MNPS"

End Sub

Die Buttons funktionieren auch alle, nur leider kommt oft eine Laufzeitfehlerneldung oder das ganze Programm hängt sich auf wenn ich erst mit dem einen Button eine Spalte eingefügt habe und im Anschluss mit dem anderen Button eine Spalte einfügen.

Es funktioniert also leider nicht verlässlich. Hat jemand eine Idee woran das liegen könnte?

Vielen Dank im Voraus!

Bild zum Beitrag
Microsoft Excel, VBA

Meistgelesene Beiträge zum Thema Microsoft Excel