238 Aufrufe
Gefragt in BS-Sonstige von addeguddi Experte (1.1k Punkte)
Hallo,

habe eine Frage wie kann ich erreichen, dass meine Wave Dateien die von 0 bis 180  deklariert sind und eine mit Game Over ansagen bei Spielende wenn in den besagten Zellen z. B. in Zelle B20 die Zahl 78 erscheint soll die dazu gehörige Wave Datei die Nr. 78 oder in Zelle C20 die Zahl 131  die Wave Datei  mit der Nr. 131 dann ansagen wen dies Zahlen vorhanden ist.

Für eine Lösung wäre ich Dankbar.

Gruß Adde

18 Antworten

0 Punkte
Beantwortet von addeguddi Experte (1.1k Punkte)
Schönen guten Morgen M.O.

vielen Dank für die Mühe die du dir gemacht hast . Es ist alles Ok was du geschrieben hast.

habe jetzt, glaube ich alles richtig auch den Pfad. Nun wenn ich auf die Zahl klicke geht ein Fenster auf und schreibt die Datei ist eine Erweiterung (.)die Media Player nicht erkennt.

Ich werde diese Dateien in ein anderes Format umwandeln in der Hoffnung das es dann funktioniert.

Herzlichen Dank nochmals

Liebe Grüße

Adde
0 Punkte
Beantwortet von m-o Profi (17.8k Punkte)

Hallo Adde,

wegen der Erweiterung schau mal, ob im Makro für Wiedergabe Der Sounddateien der Dateiname richtig zusammengesetzt wird:

'Name der abzuspielenden Datei Ermittenln
strSounddatei = lngWurf & ".mp3"


Gruß
M.O.

0 Punkte
Beantwortet von addeguddi Experte (1.1k Punkte)
Hallo M. O.

schicke dir zur Ansicht das VBA das in dem Registerblatt vorhanden ist. Ich denke das alles richtig ist. Den letzten Hinweis den du geschickt hast, habe ich geändert. Das beforedoublellick ist aus dem was du mir schon einmal erstellt hast.wenn ich das aus der Liste nehme berechnet er nichts mehr. Es ist toll wie du dich engagierst aber ich glaube, ich lass es wie jetzt ist ohne Ansage der Punkte. Du kannst deine Zeit bestimmt besser gestalten als nur für meinen Wunsch den Kopf zu zerbrechen.

Gruß Adde

'Funktion "SendMessage" deklarieren
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
ByVal lParam As Long) As Long
'Funktion "FindWindow" deklarieren
Private Declare PtrSafe Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Sub Start_Ansage(lngWurf As Long)
'Variablen deklarieren
Dim MediaPlayer As Variant
Dim strSounddatei As String
Dim strPfad As String
'Pfad, in der die Sounddateien liegen - Anpassen
strPfad = "C:\Users\Adolf\Musik\Wiedergebelisten\"
'Name der abzuspielenden Datei Ermittenln
strSounddatei = lngWurf & ".mp3"
'Mit einem Shell-Befehl den Mediaplayer aufrufen im Hintergrund und die
'Sounddatei abspielen
MediaPlayer = Shell("C:\Program Files (x86)\Windows Media Player\wmplayer.exe """ _
& strPfad & strSounddatei & """", vbHide)
End Sub

Sub Stop_Ansage()
'Funktionen "SendMessage" und "FindWindow" starten
SendMessage FindWindow(vbNullString, "Windows Media Player"), &H10, 0, 0
End Sub
 

Private Sub SpinButton1_Change()

If SpinButton1.Value < 1 Then SpinButton1.Value = ActiveSheet.Range("f1")
If SpinButton1.Value > ActiveSheet.Range("f1") Then SpinButton1.Value = 1

ActiveSheet.Range("g1") = SpinButton1.Value

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim lngSpieler As Long
Dim lngSpalte As Long
Dim lngWurf As Long
Dim lngDT As Long
Dim strSpiel As String
Dim lngZeile As Long
Dim lngSZeile As Long
Dim lngWZeile As Long
Dim lngWSpalte As Long

'Nur bei Klick im Bereich von A4 bis F14 ausführen
If Intersect(Target, Range("A4:F15")) Is Nothing Then Exit Sub

'nicht in Zelle klicken
Cancel = True
    
'Nummer des Spielers einlesen
lngSpieler = Range("G1").Value
 
'Spalte für Spieler ermitteln; Spieler stehen in Spalten K bis AH
lngSpalte = 8 + lngSpieler * 3
  
'Prüfen ob Zelle verbunden ist
If Target.Cells.Count > 1 Then
   'falls ja dann die entsprechenden Werte in Variable schreiben
    If Target.Address = "$A$15:$B$15" Then lngWurf = 25
    If Target.Address = "$C$15:$D$15" Then
         lngWurf = 50        '50 Zuweisen
         lngDT = 2           'Marker für Doppel setzen
    End If
      'prüfen, ob Fehlwurf
    If Target.Address = "$E$14:$F$14" Then lngWurf = 0
    
  Else
   'falls kein Fehlwurf
      lngWurf = Target.Value
      If Target.Column = 2 Or Target.Column = 5 Then lngDT = 2   'Marker für Doppel setzen
      If Target.Column = 3 Or Target.Column = 6 Then lngDT = 3   'Marker für Triple setzen
End If
    
'wenn Überworfen, dann Wurfergebnis auf Null setzen
If Cells(6, lngSpalte) - lngWurf < 0 Then lngWurf = 0

'Falls nur 1 übrigbleibt und damit kein Doppel-Out möglich ist, Wurf auf Null setzen
If Cells(6, lngSpalte) - lngWurf = 1 Then lngWurf = 0
  
'Fall kein Check-Out mit Doppel, dann Ergebnis des Wurfes auf Null setzen
If Cells(6, lngSpalte) - lngWurf = 0 And lngDT <> 2 Then lngWurf = 0

  
'Zeile für Würfe suchen
'dazu die Nr des Spielers herausfinden und damit Suchstring erstellen
strSpiel = "Sp" & Range("G1")
  
'Zeile für Spiel suchen
For lngZeile = 19 To 128
  If Cells(lngZeile, 1).Value = strSpiel Then
    lngSZeile = lngZeile
    Exit For
  End If
Next lngZeile
  

'Zeile für Eintrag der Würfe suchen
lngWZeile = 19 + WorksheetFunction.RoundDown(Cells(lngSZeile, 10).Value / 3, 0)
   
'Spalte für den Eintrag der Würfe ermitteln
lngWSpalte = WorksheetFunction.RoundDown(Cells(lngSZeile, 10).Value / 3, 0) + 2

'Anzahl Würfe erhöhen
Cells(lngSZeile, lngWSpalte) = Cells(lngSZeile, lngWSpalte).Value + 1

'Anzahl Doppel erhöhen
If lngDT = 2 Then Cells(11, lngSpalte + 1) = Cells(11, lngSpalte + 1).Value + 1
'Anzahl Triple erhöhen
If lngDT = 3 Then Cells(11, lngSpalte + 2) = Cells(11, lngSpalte + 2).Value + 1

'Würfe eintragen
Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1) = lngWurf

'Daten für die Rücknahme des Wurfes in das Array schreiben
arrRueck(0) = lngSZeile                                            'Zeile für Eintrag des Wurfs
arrRueck(1) = lngWSpalte                                           'Spalte für Eintrag des Wurfs
arrRueck(2) = lngSpalte                                            'Spalte für Spieler
arrRueck(3) = lngWZeile                                            'Zeile für Ergebnis des Wurfs
arrRueck(4) = lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1   'Spalte für Ergebnis des Wurfes
arrRueck(5) = lngDT                                                'Doppel oder Triple

If lngWurf > 0 Then Start_Ansage (lngWurf)

End Sub
+1 Punkt
Beantwortet von m-o Profi (17.8k Punkte)

Hallo Adde,

wie ich bereits in meiner 1. Antwort geschrieben habe, würde ich den folgenden Code in ein allgemeines Modul deiner Arbeitsmappe schreiben und nicht in das VBA-Projekt des betreffenden Arbeitsblattes:

'Funktion "SendMessage" deklarieren
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
ByVal lParam As Long) As Long
'Funktion "FindWindow" deklarieren
Private Declare PtrSafe Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Sub Start_Ansage(lngWurf As Long)
'Variablen deklarieren
Dim MediaPlayer As Variant
Dim strSounddatei As String
Dim strPfad As String
'Pfad, in der die Sounddateien liegen - Anpassen
strPfad = "C:\Users\Adolf\Musik\Wiedergebelisten\"
'Name der abzuspielenden Datei Ermittenln
strSounddatei = lngWurf & ".mp3"
'Mit einem Shell-Befehl den Mediaplayer aufrufen im Hintergrund und die
'Sounddatei abspielen
MediaPlayer = Shell("C:\Program Files (x86)\Windows Media Player\wmplayer.exe """ _
& strPfad & strSounddatei & """", vbHide)
End Sub

Sub Stop_Ansage()
'Funktionen "SendMessage" und "FindWindow" starten
SendMessage FindWindow(vbNullString, "Windows Media Player"), &H10, 0, 0
End Sub

Gruß

M.O.

0 Punkte
Beantwortet von addeguddi Experte (1.1k Punkte)
Hallo M. O.

vielen Dank, habe alles gemacht wie du es geschrieben hast. Modul angelegt, nicht in das betreffende Arbeitsblatt eingepflegt, aber es greift nicht. ich Versuche es weiter. Du musst nichts mehr diesbezüglich tun, denn ich denke, du hast alles richtig gemacht. Vielleicht stimmt auch der Pfad für dir Mp3 nicht werde es nochmals prüfen.

Gruß Adde
0 Punkte
Beantwortet von addeguddi Experte (1.1k Punkte)
Guten Morgen M.O.

Endlich klappt es.

Habe die Datei neu erstellt.Jetzt funktioniert es. Es lag am Dateipfad.Endung vergessen. Das war es.

Gruß Adde
+1 Punkt
Beantwortet von m-o Profi (17.8k Punkte)

Hallo Adde,

freut mich dass es endlich klappt. Viel Spaß beim Dart smiley.

Gruß

M.O.

0 Punkte
Beantwortet von addeguddi Experte (1.1k Punkte)
Hallo M.O.,

vielen lieben Dank nochmals für deine Geduld. Ich wollte schon aufgeben, doch du hast irgendetwas in mir geweckt, da habe ich gedacht ich muss das schaffen. Damit deine Geduld nicht umsonst war.

Einen schönen Tag noch und ich werde das Dartspielen jetzt genießen.

Gruß Adde
...