Hallo!
Weil, "Vielleicht ist dann alles schick?!" ist
nicht so! Leider!!
Als erstes hier mal die ganze HTA
<head>
<HTA:APPLICATION
APPLICATIONNAME="Zeitnahme_Vereinsskat"
ID="MyCommandApp"
BORDER="thin"
SYSMENU="no"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
ICON="Timer.ico"
SCROLL="no"
SINGLEINSTANCE="yes"
CONTEXTMENU="no"
SELECTION="no"
/>
<title>Zeitnahme Vereins-Skat</title>
<SCRIPT language="VBScript">
Dim SpielStunden : SpielStunden = 1 ' Spielzeit Stunden
Dim SpielMinuten : SpielMinuten = 45 ' Spielzeit Minuten
Dim SpielzeitRunden : SpielzeitRunden = 5 ' 1, 5, 10, 15, 30 nie 0
Dim PBHTML ' Fortschritsanzeige (rProgressbar)
Dim PBWartezeit
Dim PBHoehe
Dim PBBreite
Dim PBText
Dim PBRahmen
Dim PBUnloadedColor
Dim PBLoadedColor
Dim PBWarnung
Dim PBStartZeit
Dim PBMinuten : PBMinuten = Round((Minute(Now()) + (SpielzeitRunden / 2)) / SpielzeitRunden) * SpielzeitRunden ' aufrunden auf "SpielzeitRunden"
Dim PBTimerID1
Dim StartMinute : StartMinute = Minute(Now())
Dim StartZeit : StartZeit = CDate(Time)
Dim EndZeit : EndZeit = DateAdd("n",((SpielStunden * 60) - StartMinute + PBMinuten + SpielMinuten), StartZeit)
Dim EndMusik : EndMusik = "Ende" & (Round(CDate(Now() + Hour(Now())))) Mod 5 & ".mp3"
Sub Window_OnLoad
window.resizeTo 500,200
' Progress Bar Settings
PBWartezeit = ((SpielStunden * 3600) + (SpielMinuten * 60) - (Minute(Now()) * 60) + (PBMinuten * 60))
PBHoehe = 40 ' Progress Höhe
PBText = 20 ' Text Höhe
PBBreite= 380 ' Progress Breite
PBUnloadedColor="ForestGreen" ' Farbe noch vorhandene Zeit
PBLoadedColor="Blue" ' Farbe abgelaufene Zeit
PBRahmen="DimGray" ' Farbe Rahmen
' Bitte nie ändern!
PBStartZeit = Now
rProgressbar
PBTimerID1 = window.setInterval("rProgressbar", 1000)
End Sub
Sub rProgressbar
PBHTML = ""
PBSecsPassed = DateDiff("s",PBStartZeit,Now)
PBHouersToGo = Int((PBWartezeit - PBSecsPassed) / 3600)
PBMinsToGo = Int(((PBWartezeit - PBSecsPassed) / 60) - (PBHouersToGo *60))
PBSecsToGo = Int((PBWartezeit - PBSecsPassed) - (PBMinsToGo * 60) - (PBHouersToGo *3600))
PBWarnung = "Blue" & ">"
if PBHouersToGo < 10 then
PBHouersToGo = "0" & PBHouersToGo
end if
if PBMinsToGo < 10 then
PBMinsToGo = "0" & PBMinsToGo
end if
if PBSecsToGo < 10 then
PBSecsToGo = "0" & PBSecsToGo
end if
if PBHouersToGo <= 0 and PBMinsToGo < 15 then
PBWarnung = "red" & ">" & " <strong>"
PBLoadedColor="red"
end if
if PBHouersToGo <= 0 and PBMinsToGo < 5 then
PBWarnung = "FireBrick" & ">" & " <strong>"
PBLoadedColor="FireBrick"
end if
PBLoadedWidth = (PBSecsPassed / PBWartezeit) * PBBreite
PBUnloadedWidth = PBBreite - PBLoadedWidth
PBHTML = PBHTML & "<table border=1 bordercolor=" & PBRahmen & " cellpadding=0 cellspacing=0 width=" & PBBreite & "><tr>"
PBHTML = PBHTML & "<th width=" & PBLoadedWidth & " height=" & PBHoehe & "align=left bgcolor=" & PBLoadedColor & "></th>"
PBHTML = PBHTML & "<th width=" & PBUnloadedWidth & " height=" & PBHoehe & "align=left bgcolor=" & PBUnLoadedColor & "></th>"
PBHTML = PBHTML & "</tr></table><br>"
PBHTML = PBHTML & "<table border=0 cellpadding=0 cellspacing=0 width=" & PBBreite & "><tr>"
PBHTML = PBHTML & "<td align=center width=" & PBBreite & "% height=" & PBText & ">" & "<font color=" & PBWarnung & PBHouersToGo & ":" & PBMinsToGo & ":" & PBSecsToGo & " Zeit bis Ende!</td>"
PBHTML = PBHTML & "</tr></table>"
progressbar.InnerHTML = PBHTML
PBHTML = PBHTML & "<table border=0 cellpadding=0 cellspacing=0 width=" & PBBreite & "><tr>"
PBHTML = PBHTML & "<td align=center width=" & PBBreite & "% height=" & PBText & ">" & "<strong>" & FormatDateTime(EndZeit, 4) &" Uhr" & " ist Schluß!" & " Es wird " & FormatDateTime(PBWartezeit / 86400, 4) & " gespielt!</td>"
PBHTML = PBHTML & "</tr></table>"
progressbar.InnerHTML = PBHTML
If PBHouersToGo = 0 AND PBMinsToGo = 15 AND PBSecsToGo = 1 then
Warnungen1
end if
If PBHouersToGo = 0 AND PBMinsToGo = 5 AND PBSecsToGo = 1 then
Warnungen2
end if
If PBHouersToGo = 0 AND PBMinsToGo = 0 AND PBSecsToGo = 1 then
Warnungen3
end if
if DateDiff("s",PBStartZeit,Now) >= PBWartezeit then
StopTimer
DoAction
end if
End Sub
Sub Warnungen1
Set WshShell = CreateObject("WScript.Shell")
Return = WshShell.Run("Noch15Minuten.mp3",0,False)
Return = WshShell.Run("Warnung15min.hta",5,False)
End Sub
Sub Warnungen2
Set WshShell = CreateObject("WScript.Shell")
Return = WshShell.Run("Noch5Minuten.mp3",0,False)
Return = WshShell.Run("Warnung5min.hta",5,False)
End Sub
Sub Warnungen3
Set WshShell = CreateObject("WScript.Shell")
Return = WshShell.Run("Spielzeitbeendet.hta",5,False)
End Sub
Sub StopTimer
window.clearInterval(PBTimerID)
End Sub
Sub DoAction
Set WshShell = CreateObject("WScript.Shell")
Return = WshShell.Run(EndMusik,0,False)
Self.close
End Sub
Sub CancelAction
On Error Resume Next
Self.Close
End Sub
</SCRIPT>
<body>
<!--Verhindert HTML-Aktualisierung und/oder Beenden mit ESC; F5 und/oder AltF4-->
<SCRIPT LANGUAGE="JavaScript">
function document.onkeydown() {
var alt=window.event.altKey;
if (event.keyCode==116 || event.keyCode==27 || alt && event.keyCode==115) {
event.keyCode=0;
event.cancelBubble=true;
return false;
}
}
</SCRIPT>
<div align="center">
<strong><font color="yellow"> ♦ <font color="red"> ♥ <font color="green"> ♠ <font color="black"> ♣ Zeitnahme Vereins-Skat!<font color="black"> ♣ <font color="green"> ♠ <font color="red"> ♥ <font color="yellow"> ♦ </strong><br>.
<span id = "progressbar"></span><br>
</div>
</body>
Auf Empfehlung, wenn auch nur ähnlich, einer Seite (die ich hier nicht posten darf)
habe ich
.hta statt mit "mshta.exe in c:\windows\sysWOW64" mit "mshta.exe
in c:\windows\system32" verknüpft!
Jetzt bekomme ich keine Fehlermeldungen!
Leider bleibt sie jetzt bei 15:01, also bei
<...
If PBHouersToGo = 0 AND PBMinsToGo = 15 AND PBSecsToGo = 1 then
Warnungen1
end if
...
oder
...
Sub Warnungen1
Set WshShell = CreateObject("WScript.Shell")
Return = WshShell.Run("Noch15Minuten.mp3",0,False)
Return = WshShell.Run("Warnung15min.hta",5,False)
End Sub...
stehen, einfach stehen ohne Fehlermeldung!
Die MP3´s und HTA´s befinden sich im selben Verzeichnis!
Leider habe ich nur einmal die Woche Zugriff auf diesen Computer!
Die Frage die ich mir immer noch stelle ist:
Warum geht es bei mir (X86; alter PC (Pentium 4); WIN XP und WIN7 und WIN8 und WIN 8.1) und dort (64Bit; neuer PC; WIN8 und WIN 8.1) nicht???
Eigentlich habe ich aufgegeben, aber vielleicht hat ja einer eine Idee!
Andreas
Aufruf einer HTA aus Excel und WSH-Fehler bei deren Ablauf unter Windows 8
