@echo off
Title データ抽出
echo 同一ディレクトリに設置したcod.listに設定した文字列が存在する行を抽出する。
pause
findstr /g:code.list %1 > ex_%~n1.txt

@echo off
Title テキストデータ行数カウント
for /f "tokens=3" %%i in ('find /c /v "" %1') do set Result=%%i
echo 行数：%Result%
pause
echo %Result% > CR3_%~n1.txt

@echo off
Title テキストデータ行数カウント（0,000）
for /f "tokens=3" %%i in ('find /c /v "" %1') do set Result=%%i
set FA=%Result%
echo 行数：%FA%

Rem Result の文字数を取得
set /a len = 0
:loop
if not "%Result%"=="" (
set Result=%Result:~1%
set /a len = %len%+1
goto:loop
)

set /a FB=%len%%%3

echo　先頭文字数： %FB%
echo 桁数 %len%
set /a len=len*-1



set FR=%FA:~-3,3%
echo　最後3桁： %FR%
Rem 後ろから3桁ごとに,
setlocal enabledelayedexpansion

if %FB% neq 0 (
FOR /L %%i IN (-6,-3,%len%) DO call set FR=%%FA:~^%%i^,3%%,!FR!

call set FR=%%FA:~^%len%^,^%FB%^%%,!FR!

echo A
) else (
FOR /L %%i IN (-6,-3,%len%) DO call set FR=%%FA:~^%%i^,3%%,!FR!
echo B
)

echo　行数： %FR%

echo %FR% > CR3_%~n1.txt


pause

echo off
setlocal enabledelayedexpansion
set opt=
for %%f in (%*) do (
set opt=!opt!%%f +
echo %opt% /B
)
echo %opt%
set opt=%opt:~0,-1%
echo %opt%

copy %opt% %~p0MR_%~n1%~x1 /b
endlocal
pause

@echo off
title 分割
echo divset.ini が設定ファイル　分割行数等設定可能
setlocal enabledelayedexpansion
cd %~p0
for /f "usebackq tokens=1,* delims==" %%a in (Divset.ini) do (
set %%a=%%b
)
echo 分割後の1ファイルあたりの行数：%max%


set inputfile=%1
cd %~p0
type %inputfile% | find /v /c "" > %~p0\%~n1_line.log
for /f "usebackq tokens=*" %%i IN (%~d0%~p0%~n1_line.log) do set line= %%i
set /a filecount=%line%/%max%+1
for /f "usebackq tokens=*" %%s in (%inputfile%) do @(
set /a num=num+1
echo %%s >> split_%~n1_!filenm!.txt
if !num! equ !max! (
echo split_%~n1_!filenm!.txt 書き込み完了
set /a filenm=filenm+1
set /a num=0
)
)
:break
:end
echo 処理完了

pause

@echo off
rem****************************************************
rem**分割後の１ファイル当たりの行数をmax=に設定する **
rem****************************************************
max=1000000

rem****************************************************
rem**その他初期変数を本体でmax読込時に同時に設定する**
rem****************************************************
num=0
filenm=0
filecount=0

@echo off
REM　分割ファイル
set DivF=%1
REM 分割後ファイルパス
set DivDP=%~d0%~p0
REM 分割後ファイル名基礎
set DivAN=%~n1
REM 設定ファイルから読み込んだ設定行数
setlocal enabledelayedexpansion
cd %~p0
for /f "usebackq tokens=1,* delims==" %%a in (Divset.ini) do (
set %%a=%%b
)
echo DivF %DivF%
echo DivDP %DivDP%
echo DivAN %DivAN%
echo MyRC %MyRC%
pause

REM パワーシェルを呼び出すバッチファイルです。
REM test.ps1 が test.bat と同じフォルダにある場合です。
powershell -ExecutionPolicy Unrestricted %~d0%~p0subdiv.ps1 -DivF %DivF% -DivDP %DivDP% -DivAN %DivAN% -MyRC %MyRC%

PAUSE

REM*******************************************************************
REM**分割後ファイルの行数を設定するファイル　　　　　　 **************
REM*******************************************************************
MyRC=10000

# バッチファイルから呼び出される側のパワーシェルファイルです。
Param(
[string]$DivF,
[string]$DivDP,
[string]$DivAN,
[long]$MyRC
)
$i=0; cat $DivF -ReadCount $MyRC | % { $_ > $DivDP'Div_'$DivANz_$i.txt;$i++ }

@echo off
title 先頭100行だけ分割
setlocal enabledelayedexpansion
cd %~p0
set /a Flag=1
echo %~p0Div100_%~n1%~x1
pause
FOR /F "delims=" %%a IN (%~p1%~n1%~x1) do (
echo %%a >> %~p0Div100_%~n1%~x1
set /a Flag=!Flag!+1
if !Flag!==100 exit
)

echo 処理完了

pause

@echo off
powershell -c ^
$Sh=New-Object -COM Shell.Application ;^
dir *.wav ^| %% {^
$P=$_.FullName ;^
$FLD=Split-Path $P ;^
$File=Split-Path $P -Leaf ;^
$ShFLD=$Sh.Namespace($FLD) ;^
$ShFile=$ShFLD.ParseName($File) ;^
$T=$ShFLD.GetDetailsof($ShFile,27) ^| %% {^
$Ti=$_ -split (':') ;^
$N=[int]$Ti[0]*3600+[int]$Ti[1]*60+[int]$Ti[2]} ;^
$File+' --- '+$N > length.txt }
pause

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



Sub test()
Debug.Print "処理開始：" & Now

'500ミリ秒一時停止
Sleep 1000

Debug.Print "処理終了：" & Now
End Sub


Function GetTtsEngine(language As String, gender As String) As Object
Dim tmpPath As String
Dim saveData As Variant
Dim loadData As Variant

Static MySex As String
Static MySpeed As String
Static MyValSpeed As Long
tmpPath = Environ$("tmp") & "\vba_temp.bin"
MySex = LoadVariable(tmpPath)(0)
MySpeed = LoadVariable(tmpPath)(1)
MyValSpeed = ValSpeed_Set(MySpeed)



' 音声合成エンジンを取得する
Dim ttsEngine As Object
Set ttsEngine = CreateObject("SAPI.SpVoice")


' gender と language に合致する音声を探す (OneCoreを含めないでGetVoicesだけでは Ichiro が使えない)
Dim voice As Object
Set voice = Nothing
Set Category = CreateObject("SAPI.SpObjectTokenCategory")
Category.SetID "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Speech_OneCore\Voices", False
For Each token In Category.EnumerateTokens
If InStr(token.GetDescription, language) Then '言語
If token.GetAttribute("Gender") = gender Then '性別
Set voice = token
Set ttsEngine.voice = voice
Exit For
End If
End If
Next
' 見つからなかったら language に合致する音声を探す
If voice Is Nothing Then
For Each token In ttsEngine.GetVoices
If InStr(token.GetDescription, language) Then '言語
Set voice = token
Set ttsEngine.voice = voice
Exit For
End If
Next
End If

If voice Is Nothing Then
' 目的の音声が見つからなかった場合
Set ttsEngine = Nothing
End If
Debug.Print "ttsRate=" & Str(MyValSpeed)
ttsEngine.Rate = MyValSpeed '読み上げの速度 (遅い -10～10 速い)
Set GetTtsEngine = ttsEngine
End Function

Private Sub SpeakTexts(ByRef ttsEngine As Object, ByVal text As String)
Dim lines() As String

Const SVSFlagsAsync = 1 '非同期
Const SVSFPurgeBeforeSpeak = 2 'これまでの発話内容を取り除いてから発話

' 発声をしていたら一旦止める
ttsEngine.Speak "", SVSFPurgeBeforeSpeak ' 発声を止める

'行ごとには読み上げる
lines = Split(text, vbCr) ' 改行で分割
For Each line In lines
speechText = "<speak version=""1.0"" xml:lang=""ja-JP"">" & line & "</speak>"

DoEvents
' 中止要求があれば、実行を終了する
If StopRequestFlag Then
ttsEngine.Speak "", SVSFPurgeBeforeSpeak ' 発声を止める
SpeakingFlag = False
DoEvents
End '全体の実行を終了させる
End If
' 発声させる
ttsEngine.Speak speechText, SVSFlagsAsync '非同期処理を行う
'完了を待たないようにして、読み上げ中止ができるようにする
Next

' 読み上げの完了を待つ
Do Until ttsEngine.WaitUntilDone(500) ' 500msごとに
' イベント処理を行って中断できるようにする
DoEvents
' 中止要求があれば、実行を終了する
If StopRequestFlag Then
ttsEngine.Speak "", SVSFPurgeBeforeSpeak ' 発声を止める
SpeakingFlag = False
DoEvents
End '全体の実行を終了させる
End If
Debug.Print ("."); '繰り返し毎に「.」を表示(末尾の改行なし)
Loop
Debug.Print ("SpeakTexts done!")


End Sub

Sub SpeakNote()
Dim tmpPath As String
Dim saveData As Variant
Dim loadData As Variant

Static MySex As String
Static MySpeed As String
Static MyValSpeed As Long
tmpPath = Environ$("tmp") & "\vba_temp.bin"
MySex = LoadVariable(tmpPath)(0)
MySpeed = LoadVariable(tmpPath)(1)
MyValSpeed = ValSpeed_Set(MySpeed)

Sleep 3000
Debug.Print "SpeakingFlag = " & SpeakingFlag
If SpeakingFlag = True Then '既に実行中なら無視
GoTo Skip
End If
StopRequestFlag = False
SpeakingFlag = True
Debug.Print " 音声合成エンジンを取得 "
' 音声合成エンジンを取得する
Dim ttsEngine As Object
Set ttsEngine = GetTtsEngine("Japanese", MySex)
Debug.Print "1"
' 適切な音声エンジンが見つからなかった場合
If ttsEngine Is Nothing Then
' 発見に失敗した旨をメッセージボックスで通知
MsgBox "適切な日本語の音声が見つかりませんでした。"
Exit Sub
End If



' スライドのノートのテキストを取得して音声ファイルに変換する
Dim aSlide As Slide
Dim aShape As Shape
Dim slideNo As Integer
'スライドショーで示しているスライド番号を取得
Debug.Print "2"
slideNo = SlideShowWindows(1).View.CurrentShowPosition
Set aSlide = ActivePresentation.Slides(slideNo)
'slideNo = aSlide.slideNumber
Debug.Print "3"
For Each aShape In aSlide.NotesPage.Shapes
If aShape.PlaceholderFormat.Type = ppPlaceholderBody Then
If aShape.HasTextFrame Then
If aShape.TextFrame.HasText Then
' 発話テキスト
Dim speechText As String
strNotesText = aShape.TextFrame.TextRange.text
Debug.Print "note" & strNotesText
' 発声させる
Call SpeakTexts(ttsEngine, strNotesText)
End If
End If
End If
Next aShape
Debug.Print "4"
' 音声合成エンジンを解放する
DoEvents
Set ttsEngine = Nothing
SpeakingFlag = False
DoEvents
Skip:
End Sub

Sub RequestStop()
StopRequestFlag = True
Debug.Print "StopRequestFlag"
End Sub


Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)

'スライドの遷移が起きたら、読み上げを中止する
RequestStop
DoEvents
SpeakingFlag = False
DoEvents
If Not SlideShowWindows(1).View.CurrentShowPosition = 1 Then
Application.SlideShowWindows(1).View.Previous
Application.SlideShowWindows(1).View.Next
Else
Application.SlideShowWindows(1).View.Next
Application.SlideShowWindows(1).View.Previous
End If

Dim Mymenubar As CommandBar
DoEvents
Set Mymenubar = Application.CommandBars("Slide Show Browse")
Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = False
Debug.Print "Enabled_False"
DoEvents
Call SpeakNote
End Sub

Public Sub OnSlideShowTerminate(ByVal Wn As SlideShowWindow)
'スライドショーが終わったら、読み上げを中止する
RequestStop
End Sub

Sub SpeakButtonOnMaster_Click()
Call SpeakNote
End Sub

Sub StopButtonOnMaster_Click()
'「読み上げ中止」ボタンがクリックされたら、読み上げを中止する
RequestStop
End Sub
Sub SpeakNote_Make_test()
Dim tmpPath As String
Dim saveData As Variant
Dim loadData As Variant

Static MySex As String
Static MySpeed As String
Static MyValSpeed As Long
tmpPath = Environ$("tmp") & "\vba_temp.bin"
MySex = LoadVariable(tmpPath)(0)
MySpeed = LoadVariable(tmpPath)(1)
MyValSpeed = ValSpeed_Set(MySpeed)

Debug.Print "SpeakingFlag = " & SpeakingFlag
If SpeakingFlag = True Then '既に実行中なら無視
GoTo Skip
End If
StopRequestFlag = False
SpeakingFlag = True
Debug.Print " 音声合成エンジンを取得 "
' 音声合成エンジンを取得する
Dim ttsEngine As Object
Set ttsEngine = GetTtsEngine("Japanese", MySex)
Debug.Print "1"
' 適切な音声エンジンが見つからなかった場合
If ttsEngine Is Nothing Then
' 発見に失敗した旨をメッセージボックスで通知
MsgBox "適切な日本語の音声が見つかりませんでした。"
Exit Sub
End If


' 現在のスライド番号を取得
Dim n As Long
n = ActiveWindow.Selection.SlideRange.SlideIndex

' 現在のスライドのノートを取得
Dim strNote As String
strNote = ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text

' ノートが空白なら終了
If strNote = "" Then
Exit Sub
End If

' 発声させる
Call SpeakTexts(ttsEngine, strNote)
' 音声合成エンジンを解放する
DoEvents
Set ttsEngine = Nothing
SpeakingFlag = False
DoEvents
Skip:
End Sub

Sub Reg_txt()
Dim oReg As Object
Dim itmsu As Integer
Dim tst As String
Dim n As Long
Dim Myaray As Variant
Dim strNote As String
Dim Myend As Long
Dim Mydic As Object
Dim MyFilename As String

Set Mydic = CreateObject("Scripting.Dictionary")

Myend = ActivePresentation.Slides.Count

Set oReg = CreateObject("VBScript.RegExp")

For n = 1 To Myend
' 現在のスライドのノートを取得
strNote = ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text
' ノートが空白なら終了
If strNote = "" Then
GoTo anc
End If

'oReg.Pattern = "<phoneme alphabet=""sapi"" ph=""[^>]+>(.+?)?</phoneme>" '2021/03/20変更
oReg.Pattern = "<phoneme alphabet=""(sapi|ups)"" ph=""?(.+?)?"">(.+?)?</phoneme>" '2021/03/20 alphabet="ups"パターン追加、正規表現見直し
oReg.Global = True

itmsu = oReg.Execute(strNote).Count
If itmsu = 0 Then GoTo anc
ReDim Myaray(1 To itmsu, 1 To 3)
With oReg.Execute(strNote)
For j = 0 To itmsu - 1
Myaray(j + 1, 1) = .item(j).SubMatches(2) '2021/03/20変更
Debug.Print "1:" & .item(j).SubMatches(2) '2021/03/20変更
Myaray(j + 1, 2) = .item(j).SubMatches(1) '2021/03/20追加
Debug.Print "2:" & .item(j).SubMatches(1) '2021/03/20追加
Myaray(j + 1, 3) = .item(j).SubMatches(0) '2021/03/20追加
Debug.Print "3:" & .item(j).SubMatches(0) '2021/03/20追加

Next j
End With

'oReg.Pattern = "<phoneme alphabet=""sapi"" ph=""?(.+?)?"">" '2021/03/20正規表現見直し
'oReg.Global = True

'With oReg.Execute(strNote)
' For j = 0 To itmsu - 1
' Myaray(j + 1, 2) = .item(j).SubMatches(1) '()でククッタ箇所取り出し
' Debug.Print "2:" & .item(j).SubMatches(1)
'Next j
'End With


For j = 1 To UBound(Myaray)
If Mydic.Exists(Myaray(j, 1)) = False Then
Mydic.Add Myaray(j, 1), Myaray(j, 2) & "," & Myaray(j, 3)
End If
Next j
anc:
Next n
Set oReg = Nothing

ReDim Myaray(1 To Mydic.Count, 1 To 2)
For j = 1 To UBound(Myaray)
Myaray(j, 1) = Mydic.Keys()(j - 1)
Myaray(j, 2) = Mydic.Items()(j - 1)
Next j

MyFilename = "TTSph.csv"
Call CSV_export(Myaray, MyFilename)

End Sub
'Sub CSV_export(Myaray As Variant)　　　　　　　　　　　’2021/03/20　↓変更
Sub CSV_export(Myaray As Variant, MyFilename As String) '2021/03/20　MyFilename As String　追加
Myaray = Myaray
MyFilename = MyFilename
Dim csv As String ' CSV に書き込む全データ
Dim line As String ' 1 行分のデータ
Dim Mypath As String
Mypath = ActivePresentation.Path

For i = LBound(Myaray) To UBound(Myaray)

line = ""
For i2 = LBound(Myaray, 2) To UBound(Myaray, 2) ' 列のループ
Dim item As Variant
item = Myaray(i, i2)
If line = "" Then
line = item
Else
line = line & "," & item
End If

Next i2

' 行を結合
If csv = "" Then
csv = line
Else
csv = csv & vbCrLf & line
End If
Next i

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim Ts As Object
'Mypath = Mypath & "\" & "TTSph.csv" '2021/03/20 ↓変更
Mypath = Mypath & "\" & MyFilename 'ファイル名を変数に変更
Set Ts = fso.CreateTextFile(Mypath, True)

Ts.Write (csv) ' 書き込み

Ts.Close ' ファイルを閉じる

' 後始末
Set Ts = Nothing
Set fso = Nothing

End Sub
Sub ph_Del_Replace()
Dim oReg As Object
Dim itmsu As Integer
Dim tst As String
Dim n As Long
Dim Myaray As Variant
Dim Myend As Long

Myend = ActivePresentation.Slides.Count

Set oReg = CreateObject("VBScript.RegExp")
'oReg.Pattern = "<phoneme alphabet=""sapi"" ph=""[^>]+>|</phoneme>" 　　　　　　　　　　　　　　　　　　　'2021/03/20 ↓へ変更
oReg.Pattern = "<phoneme alphabet=""(sapi|ups)"" ph=""[^>]+>|</phoneme>" '2021/03/20 <phoneme alphabet=""ups"" ph=""[^>]+>|追加
oReg.Global = True

For n = 1 To Myend

Dim strNote As String
strNote = ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text

' ノートが空白なら終了
If strNote = "" Then
GoTo anc
End If

strNote = oReg.Replace(strNote, "")

ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text = strNote

anc:
Next n
Set oReg = Nothing

End Sub
Sub Note_Replace()
Dim Myaray As Variant
Dim Mypath As String
Dim strNote As String
Dim n As Long
Dim Myend As Long

Mypath = ActivePresentation.Path & "\TTSph.csv"
Myaray = CSV_import(Mypath)

Myend = ActivePresentation.Slides.Count

For n = 1 To Myend

strNote = ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text
' ノートが空白なら終了
If strNote = "" Then
GoTo anc
End If

For i = 1 To UBound(Myaray)
If Myaray(i, 3) = "sapi" Then '2021/03/20
strNote = Replace(strNote, Myaray(i, 1), "<phoneme alphabet=""sapi"" ph=""" & Myaray(i, 2) & """>" & Myaray(i, 1) & "</phoneme>")
ElseIf Myaray(i, 3) = "ups" Then '2021/03/20
strNote = Replace(strNote, Myaray(i, 1), "<phoneme alphabet=""ups"" ph=""" & Myaray(i, 2) & """>" & Myaray(i, 1) & "</phoneme>") '2021/03/20
End If '2021/03/20
Next i
ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text = strNote
anc:
Next n

End Sub
Function CSV_import(Mypath As String) As Variant
Dim file As String
Dim max_n As Long
Dim buf As String
Dim tmp As Variant
Dim ary() As Variant
Dim i As Long
Dim Mycol As Long
Dim n As Long
Dim val As Long
Mypath = Mypath

'準備
max_n = CreateObject("Scripting.FileSystemObject").OpenTextFile(Mypath, 8).line 'ファイルの行数取得
Mycol = 2
ReDim ary(1 To max_n, 1 To Mycol) As Variant '取得した行数で2次元配列の再定義

'CSVファイルを配列へ
Open Mypath For Input As #1 'CSVファイルを開く
n = 1
Do Until EOF(1) '最終行までループ
Line Input #1, buf '読み込んだデータを1行ずつみていく
tmp = Split(buf, ",") 'カンマで分割
If Mycol < UBound(tmp) + 1 Then
Mycol = UBound(tmp) + 1
ReDim Preserve ary(1 To max_n, 1 To Mycol)
End If
For i = 1 To UBound(tmp) + 1 '項目数ぶんループ
ary(n, i) = tmp(i - 1) '分割した内容を配列の項目へ入れる
Next i
n = n + 1 '配列の次の行へ
Loop
Close #1 'CSVファイルを閉じる

CSV_import = ary

End Function


Sub Write_break_time()
ActiveWindow.Selection.TextRange = "<break time=""500ms"" />"

End Sub

Sub selection_tts()
Dim tmpPath As String
Dim saveData As Variant
Dim loadData As Variant

Static MySex As String
Static MySpeed As String
Static MyValSpeed As Long
tmpPath = Environ$("tmp") & "\vba_temp.bin"
MySex = LoadVariable(tmpPath)(0)
MySpeed = LoadVariable(tmpPath)(1)
MyValSpeed = ValSpeed_Set(MySpeed)

Debug.Print "SpeakingFlag = " & SpeakingFlag
If SpeakingFlag = True Then '既に実行中なら無視
GoTo Skip
End If
StopRequestFlag = False
SpeakingFlag = True
Debug.Print " 音声合成エンジンを取得 "
' 音声合成エンジンを取得する
Dim ttsEngine As Object
Set ttsEngine = GetTtsEngine("Japanese", MySex)
Debug.Print "1"
' 適切な音声エンジンが見つからなかった場合
If ttsEngine Is Nothing Then
' 発見に失敗した旨をメッセージボックスで通知
MsgBox "適切な日本語の音声が見つかりませんでした。"
Exit Sub
End If

strNote = ActiveWindow.Selection.TextRange

' ノートが空白なら終了
If strNote = "" Then
MsgBox "ノートの文字を選択してください。" '2020/03/20追加
Exit Sub
End If

' 発声させる
Call SpeakTexts(ttsEngine, strNote)
' 音声合成エンジンを解放する
DoEvents

Set ttsEngine = Nothing
SpeakingFlag = False
DoEvents

Skip:

End Sub

Function Myadvancetime_export() As Variant
Dim n As Long
Dim MyE As Long
Dim Atime As Double
Dim Myaray() As Variant
Dim Totaltime As Double
Dim Th As Integer
Dim Tm As Integer
Dim Ts As Double
Dim MyFilename As String

Debug.Print n
Debug.Print MyE
Debug.Print Atime
Debug.Print Totaltime
Debug.Print Th
Debug.Print Tm
Debug.Print Ts
MyE = ActivePresentation.Slides.Count

ReDim Myaray(1 To MyE + 2, 1 To 2)

Myaray(1, 1) = "スライドNo"
Myaray(1, 2) = "設定時間（秒）"

Totaltime = 0

For n = 2 To MyE + 1
Myaray(n, 1) = Format(n - 1, "000")
Atime = ActivePresentation.Slides(n - 1).SlideShowTransition.AdvanceTime
Myaray(n, 2) = Trim(Str(Atime))
Totaltime = Totaltime + Atime
Next n

Th = Totaltime \ 360
Tm = (Totaltime - (Th * 360)) \ 60
Ts = Totaltime - (Th * 360) - (Tm * 60)

If Not Int(Ts) = Ts Then
Ts = Int(Ts) + 1
Else
Ts = Int(Ts)
End If

Myaray(MyE + 2, 1) = "設定時間計"
Myaray(MyE + 2, 2) = Format(Th, "00") & ":" & Format(Tm, "00") & ":" & Format(Ts, "00")





For i = LBound(Myaray) To UBound(Myaray)
Debug.Print Myaray(i, 1) & "," & Myaray(i, 2)
Next i
n = 0
MyE = 0
Atime = 0
Totaltime = 0
Th = 0
Tm = 0
Ts = 0

Myadvancetime_export = Myaray
End Function

Sub a()
Dim MyFilename As String
Dim Myaray As Variant

Myaray = Myadvancetime_export
MyFilename = "ATime.csv"
Call CSV_export(Myaray, MyFilename)

End Sub

Sub インポート()
Dim Mypath As String
Dim Myaray As Variant
Dim Endrow As Long
Dim i As Long
Dim j As Long
Dim Mykey As String
Dim Myitem(1 To 2) As String '2020/03/20
Dim Mydic As Object
Dim New_item As Variant

Set Mydic = CreateObject("Scripting.Dictionary")
Sheets(2).Cells.ClearContents
'管理シートの内容をMydicに登録
Endrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Endrow
Mykey = Sheets(1).Cells(i, 1).Value
Myitem(1) = Sheets(1).Cells(i, 2).Value '2020/03/20
Myitem(2) = Sheets(1).Cells(i, 3).Value '2020/03/20
If Mydic.Exists(Mykey) = False Then
Mydic.Add Mykey, Myitem
End If
Next i

'TTSphをロードして配列に格納し、新規表示用の列を作る
Mypath = ThisWorkbook.Path & "\TTSph.csv"
Myaray = CSV_import(Mypath)
ReDim Preserve Myaray(1 To UBound(Myaray), 1 To UBound(Myaray, 2) + 1)

'TTSphをMydicでチェックして、管理シートにないデータがあれば、New_itemの配列を拡張して格納する。
j = 0 'New_item行数用
ReDim New_item(1 To UBound(Myaray), 1 To 3) '2020/03/20
For i = 1 To UBound(Myaray)
If Mydic.Exists(Myaray(i, 1)) = False And Not Myaray(i, 1) = "" Then
j = j + 1
New_item(j, 1) = Myaray(i, 1)
New_item(j, 2) = Myaray(i, 2) '2020/03/20
New_item(j, 3) = Myaray(i, 3) '2020/03/20
Myaray(i, UBound(Myaray, 2)) = "新規" '2020/03/20
End If
Next i

ThisWorkbook.Sheets(2).Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(UBound(Myaray), UBound(Myaray, 2))) = Myaray 'チェックTTSにインポート結果表示

ThisWorkbook.Sheets(1).Range(Sheets(1).Cells(Endrow + 1, 1), Sheets(1).Cells(Endrow + UBound(New_item), 3)) = New_item '管理マスタに新規アイテム追加
Debug.Print New_item(UBound(New_item), UBound(New_item, 2))
End Sub

Function CSV_import(Mypath As String) As Variant
Dim file As String
Dim max_n As Long
Dim buf As String
Dim tmp As Variant
Dim ary() As Variant
Dim i As Long
Dim Mycol As Long
Dim n As Long
Dim val As Long
Mypath = Mypath

'準備
max_n = CreateObject("Scripting.FileSystemObject").OpenTextFile(Mypath, 8).line 'ファイルの行数取得
Mycol = 2
ReDim ary(1 To max_n, 1 To Mycol) As Variant '取得した行数で2次元配列の再定義

'CSVファイルを配列へ
Open Mypath For Input As #1 'CSVファイルを開く
n = 1
Do Until EOF(1) '最終行までループ
Line Input #1, buf '読み込んだデータを1行ずつみていく
tmp = Split(buf, ",") 'カンマで分割
If Mycol < UBound(tmp) + 1 Then
Mycol = UBound(tmp) + 1
ReDim Preserve ary(1 To max_n, 1 To Mycol)
End If
For i = 1 To UBound(tmp) + 1 '項目数ぶんループ
ary(n, i) = tmp(i - 1) '分割した内容を配列の項目へ入れる
Next i
n = n + 1 '配列の次の行へ
Loop
Close #1 'CSVファイルを閉じる

CSV_import = ary

End Function
Sub エクスポート()
Dim Myaray As Variant
Dim Endrow As Long
Dim MyFilename As String
'↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓2020/03/20 追加↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
Dim mystr As String
Dim Mydic As Object
Dim Mysheet As Worksheet
Dim i As Long
Dim Mykey As String
Dim Myitem As String
Dim Testflag As Boolean

Set Mysheet = Sheets("ups")
Set Mydic = CreateObject("Scripting.Dictionary")
Erow = Mysheet.Cells(Rows.Count, 1).End(xlUp).Row
Myarray = Mysheet.Range(Mysheet.Cells(2, 1), Mysheet.Cells(Erow, 1))

For i = LBound(Myarray) To UBound(Myarray)
Mykey = UCase(Myarray(i, 1))
Myitem = Myarray(i, 1)
If Mydic.Exists(Mykey) = False Then
Mydic.Add Mykey, Myitem
End If
Next i
Erase Myarray

'↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑2020/03/20 追加↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

Endrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Myaray = Sheets(1).Range(Sheets(1).Cells(2, 1), Sheets(1).Cells(Endrow, 3))

'↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓2020/03/20 追加↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
For i = LBound(Myaray) To UBound(Myaray)

If Myaray(i, 3) = "ups" And ups_check(CStr(Myaray(i, 2)), Mydic) = True Then
MsgBox "upsに使用できない文字が入力されています。" & vbCrLf & "確認してください。"
Exit Sub
ElseIf Myaray(i, 3) = "sapi" And Kana_Check(CStr(Myaray(i, 2))) = True Then
MsgBox "sapiのヨミガナは全角カタカナで入力してください。"
Exit Sub
ElseIf Not Myaray(i, 3) = "sapi" And Not Myaray(i, 3) = "ups" Then
MsgBox "区分にsapiとups以外の文字が入力されています。" & vbCrLf & "確認してください。"
Exit Sub
End If
Next i

'↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑2020/03/20 追加↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑


MyFilename = "TTSph.csv" '2020/03/20ファイル名引数変更
Call CSV_export(Myaray, MyFilename) '2020/03/20ファイル名引数変更

End Sub


Sub CSV_export(Myaray As Variant, MyFilename As String) '2020/03/20ファイル名を引数に変更
Myaray = Myaray
MyFilename = MyFilename
Dim csv As String ' CSV に書き込む全データ
Dim line As String ' 1 行分のデータ
Dim Mypath As String
Mypath = ThisWorkbook.Path

For i = LBound(Myaray) To UBound(Myaray)

line = ""
For i2 = LBound(Myaray, 2) To UBound(Myaray, 2) ' 列のループ
Dim item As Variant
item = Myaray(i, i2)
If line = "" Then
line = item
Else
line = line & "," & item
End If

Next i2

' 行を結合
If csv = "" Then
csv = line
Else
csv = csv & vbCrLf & line
End If
Next i

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim ts As Object
Mypath = Mypath & "\" & MyFilename '2020/03/20ファイル名を引数に変更
Set ts = fso.CreateTextFile(Mypath, True, True)

ts.Write (csv) ' 書き込み

ts.Close ' ファイルを閉じる

' 後始末
Set ts = Nothing
Set fso = Nothing
End Sub

Function ups_check(mystr As String, Mydic As Object) As Boolean '2020/03/20 追加
mystr = Trim(mystr)
Set Mydic = Mydic

Dim Myarray As Variant
Dim i As Long
Dim Mykey As String

Myarray = Split(mystr, " ")

For i = LBound(Myarray) To UBound(Myarray)
Mykey = UCase(Myarray(i))
If Mydic.Exists(Mykey) = False Then
ups_check = True
Exit Function
End If
Next i

End Function
Function Kana_Check(mystr As String) As Boolean '2020/03/20追加
mystr = Trim(mystr)

Dim i As Long

For i = 1 To Len(mystr)
If Not (Mid(mystr, i, 1) Like "[ア-ヴ]") Then
Kana_Check = True
Exit Function
End If
Next i

End Function

Sub upse() '2020/03/20追加
Dim Myaray As Variant
Dim MyFilename As String
MyFilename = "UPS.csv"
Myaray = Sheets("ups").Cells(1, 1).CurrentRegion
Call CSV_export(Myaray, MyFilename)
End Sub

setlocal enabledelayedexpansion

set Filelist=
for %%f in (%*) do (
set Filelist=!Filelist!file '%%f'^


)
echo !Filelist! > %~dp0list.txt

sort %~dp0list.txt /o %~dp0list.txt

ffmpeg -safe 0 -f concat -i %~dp0list.txt -vcodec libx264 -acodec libmp3lame -s 640x360 -b:v 600k -r 15 %~dp0output.mp4
rem ffmpeg -i [元動画] -movflags faststart -vcodec libx264 -acodec libfaac
rem -s 740x480 アナログテレビ
rem -vf "scale=trunc(iw/2)*2:trunc(ih/2)*2"　基サイズ尊重
rem -s 640x360 ノートパソコン
rem -b:v 1200k ビットレート
rem -r 30 フレームレート
rem ffmpeg -i GhostOfTsushima.mp4 GhostOfTsushima_mini.mp4
del %~dp0list.txt


pause

ひらがな,UPS
あ,a
い,i
う,u
え,e
お,ox
か,k a
き,k i
く,k uu
け,k e
こ,k ox
さ,s a
し,sh i
す,s uu
せ,s e
そ,s ox
た,t a
ち,t sh i
つ,t s uu
て,t e
と,t ox
な,n a
に,nj i
ぬ,n uu
ね,n e
の,n ox
は,h a
ひ,c i
ふ,h uu
へ,ph e
ほ,h ox
ま,m a
み,m i
む,m uu
め,m ee
も,m ox
や,y a
ゆ,y uu
よ,y ox
ら,r a
り,r i
る,r u
れ,r e
ろ,r ox
わ,w a
を,w ox
ん,qn
が,ng a
ぎ,ng i
ぐ,ng u
げ,ng e
ご,ng ox
ざ,dz a
じ,dz i
ず,dz uu
ぜ,dz e
ぞ,dz ox
だ,d a
で,d e
ど,d o
ば,b a
び,b i
ぶ,b uu
べ,b e
ぼ,b ox
ぱ,p ae
ぴ,p i
ぷ,p uu
ぺ,p e
ぽ,p ox
きゃ,k j a
きゅ,k j uu
きょ,k j ox
しゃ,sh a
しゅ,sh uu
しょ,sh ox
ちゃ,t sh a
ちゅ,cc uu
ちょ,t sh ox
にゃ,nj a
にゅ,nj uu
にょ,nj ox
ひゃ,c j a
ひゅ,c j uu
ひょ,c j ox
みゃ,m j a
みゅ,m j uu
みょ,m j ox
りゃ,r j a
りゅ,r j uu
りょ,r j ox
ぎゃ,ng j a
ぎゅ,ng j u
ぎょ,ng j ox
じゃ,dz j a
じゅ,dz j uu
じょ,dz j ox
びゃ,b j a
びゅ,b j uu
びょ,b j ox
ぴゃ,p j a
ぴゅ,p j uu
ぴょ,p j ox

UPS,IPA,Unicode,SAPI ID,IpaASCII,X-SAMPA,Example,Language
I,i,U+0069,69,I,i,feel,English
Y,y,U+0079,79,Y,y,du,French
IX,ɨ,U+0268,268,i",1,,
YX,ʉ,U+0289,289,U",},,
UU,ɯ,U+026F,026F,u-,M,,
U,u,U+0075,75,u,u,too,English
IH,ɪ,U+026A,026A,I,I,fill,English
YH,ʏ,U+028F,028F,I.,Y,hübsch,German
UH,ʊ,U+028ª,028ª,U,U,book,English
E,e,U+0065,65,e,e,ses,French
EU,ø,U+00F8,00F8,Y,2,blöd,German
EX,ɘ,U+0258,258,@<umd>,@\,,
OX,ɵ,U+0275,275,,8,,
OU,ɤ,U+0264,264,o-,7,,
O,o,U+006F,006F,o,o,go,English
AX,ə,U+0259,259,@,@,ago,English
AX rho,ɚ,U+025ª,0259 02DE,R,,forensic,English
EH,ɛ,U+025B,025B,E,E,pet,English
OE,œ,U+0153,153,W,9,plötzlich,German
ER,ɜ,U+025C,025C,V",3,bird,UK English
ER rho,ɝ,U+025D,025C 02DE,@.,,bird,US English
UR,ɞ,U+025E,025E,O",3\,,
AH,ʌ,U+028C,028C,V,V,cut,English
AO,ɔ,U+0254,254,O,O,dog,English
AE,æ,U+00E6,0,&,{,cat,English
AEX,ɐ,U+0250,250,,6,Besser,German
A,a,U+0061,61,a,a,valle,Spanish
AOE,ɶ,U+0276,276,&.,&,,
AA,ɑ,U+0251,251,A,A,father,English
Q,ɒ,U+0252,252,A.,Q,hot,English
P,p,U+0070,70,P,P,put,English
B,b,U+0062,62,B,B,big,English
M,m,U+006D,006D,M,M,mat,English
BB,ʙ,U+0299,299,B<trl>,B\,,
PH,ɸ,U+0278,278,P,p\,,
BH,β,U+03B2,03B2,B,B,kabra,Spanish
MF,ɱ,U+0271,271,M,F,,
F,f,U+0066,66,F,F,fork,English
V,v,U+0076,76,V,V,vat,English
VA,ʋ,U+028B,028B,R<lbd>,V\,,
TH,θ,U+03B8,03B8,T,T,thin,English
DH,ð,U+00F0,00F0,D,D,then,English
T,t,U+0074,74,T,T,talk,English
D,d,U+0064,64,D,D,dig,English
N,n,U+006E,006E,N,N,no,English
RR,r,U+0072,72,R<trl>,,torre, rojo,Spanish
DX,ɾ,U+027E,027E,*,4,butter,US English
S,s,U+0073,73,S,S,sit,US English
Z,z,U+007A,007A,z,Z,zap,US English
LSH,ɬ,U+026C,026C,,K,,
LH,ɮ,U+026E,026E,z<lat>,K\,caballo,Spanish/Zulu
RA,ɹ,U+0279,279,r,r\,puro,Spanish
L,l,U+006C,006C,l,L,lid,US English
L vel,ɫ,U+026B,006C 02E0,,,,
SH,ʃ,U+0283,283,S,S,she,US English
SH pal,ʆ,U+0286,0283 02B2,,,,
ZH,ʒ,U+0292,292,Z,Z,pleasure,US English
ZH pal,ʓ,U+0293,0292 02B2,,,,
TR,ʈ,U+0288,288,t.,t`,,
DR,ɖ,U+0256,256,d.,D`,,
NR,ɳ,U+0273,273,n.,N`,,
DXR,ɽ,U+027D,027D,*.,r`,,
SR,ʂ,U+0282,282,s.,S`,,
ZR,ʐ,U+0290,290,z.,Z`,,
R,ɻ,U+027B,027B,r.,R,red,US English
LR,ɭ,U+026D,026D,l.,l`,,
RR rho,ɼ,U+027C,0072 02DE,,,,
CT,c,U+0063,63,c,C,,
JD,ɟ,U+025F,025F,J,J\,,
NJ,ɲ,U+0272,272,,J,oignon,French
C,ç,U+00E7,0,C,C,sicher,German
CJ,ʝ,U+029D,029D,C<vcd>,j\,,
J,j,U+006A,006A,j,J,yard,US English
LJ,ʎ,U+028E,028E,l^,L,gli,Italian
W,w,U+0077,77,w,W,with,US English
K,k,U+006B,006B,k,K,cut,US English
G,g,U+0067,67,g,G,gut,US English
NG,ŋ,U+014B,014B,N,N,sing,US English
X,x,U+0078,78,x,X,mujer,Spanish
GH,ɣ,U+0263,263,Q,7,luego,Spanish
GA,ɰ,U+0270,270,j<vel>,M\,,
GL,ʟ,U+029F,029F,L,L\,,
QT,q,U+0071,71,q,Q,,
QD,ɢ,U+0262,262,G,G\,,
QN,ɴ,U+0274,274,n",N\,,
QQ,ʀ,U+0280,280,-,R\,,
QH,χ,U+03C7,03C7,X,X,,
RH,ʁ,U+0281,281,g",R,rond,French
HH,ħ,U+0127,127,H,X\,,
HG,ʕ,U+0295,295,H<vcd>,?\,,
GT,ʔ,U+0294,294,?,?,,
H,h,U+0068,68,h,H,help,US English
WJ,ɥ,U+0265,265,j<rnd>,H,huit;juin,French
PCK,ʘ,U + 0298,298,O \,,,
TCK,ǀ,U + 01C0,01C0,| \,,,
NCK,！,U + 0021,21,！\,,,
CCK,ǂ,U + 01C2,01C2,= \,,,
LCK,ǁ,U + 01C1,01C1,| \ | \,,,
BIM,ɓ,U + 0253,253,b_ <,,,
DIM,ɗ,U + 0257,257,d_ <,,,
QIM,ʛ,U + 029B,029B,,,,
vls,ʠ,U + 02A0,029B 030A,,,,
GIM,ɠ,U + 0260,260,g_ <,,,
JIM,ʄ,U + 0284,284,,,,
ejc,pʼ,0070 02BC,0070 02BC,b_>,,,
+,U+0361,361,tie bar,,,,
adv,o̟,U+031F,031F,,_+,,
api,t̺,U+033A,033A,,_a,,
asp,tʰ,U+02B0,02B0,<h> {asp},_h,,
atr,e̘,U+0318,318,,_A,,
bvd,b̤,U+0324,324,,_t,,
cen,ë,U+0308,308,,_",,
cvd,b̰,U+0330,330,,_k,,
den,t̪,U+032A,032A,[ / {dnt},_d,,
lab,tʷ,U+02B7,02B7,<w> {lzd},_w,,
lam,t̻,U+033B,033B,,_m,,
lar,dˡ,U+02E1,20,,_l,,
lla,n̼,U+033C,033C,,_N,,
low,e̞,U+031E,031E,,_o,,
lrd,o̜,U+031C,031C,,_c,,
mcn,e̽,U+033D,033D,,,,
mrd,o̹,U+0339,339,,_O,,
nar,d̚,U+031A,031A,,_},,
nas,ñ,U+0303,303,~ / <nzd>,~ / _~,,
nsr,oⁿ,U+207F,207F,,_n,,
nsy,n̯,U+032F,032F,,_^,,
pal,tʲ,U+02B2,02B2,; / {pzd},',,
phr,nˤ,U+02E4,20000,,_?\,,
rai,e̝,U+031D,031D,,_r,,
ret,o̱,U+0331,331,,_-,,
rho,ə˞,U+02DE,02DE,,`,,
rtr,e̙,U+0319,319,,_q,,
syl,n̩,U+0329,329,{syl},= / _=,,
vcd,s̬,U+032C,032C,,_v,,
vel,tˠ,U+02E0,2,{vzd},_G,,
vph,l̴,U+0334,334,{fzd},_e,,
S1,ˈ,U+02C8,02C8,",1,,
S2,ˌ,U+02CC,02CC,%,2,,
.,.,U+002E,002E,,,,
_|,|,U+007C,007C,,,,
_||,‖,U+2016,2016,,,,
lng,ː,U+02D0,02D0,:,,,
hlg,ˑ,U+02D1,02D1,:\,,,
xsh,˘,U+02D8,02D8,_X,,,
_^,U+203F,203F,linking (absence of a break),,,,
_!,,,1,,! Sentence terminator (exclamation mark),,
_&,,,2,,& Word boundary,,
_,,,,3,,, Sentence terminator (comma),,
_s,,,4,,_ Silence (underscore),,
_.,,U+2198,2198,,. Sentence terminator (period),,
_?,,U+2197,2197,,? Sentence terminator (question mark),,
T5,e̋,U+030B,030B,_T,,,
T4,é,U+0301,301,_H,,,
T3,ē,U+0304,304,_M,,,
T2,è,U+0300,300,_L,,,
T1,ȅ,U+030F,030F,_B,,,
T-,↓,U+2193,2193,!,,,
T+,↑,U+2191,2191,^,,,

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Public StopRequestFlag As Boolean '読み上げ中止要求フラグ
Public SpeakingFlag As Boolean '読み上げ中フラグ
Public strNotesText As String

Sub Slideshow_End_False()
Dim CommandBarItem As CommandBar
Dim CommandBarControlItem As CommandBarControl

'ずっと残るのでリセット
For Each CommandBarItem In Application.CommandBars
For Each CommandBarControlItem In CommandBarItem.Controls
On Error Resume Next: CommandBarControlItem.Reset: On Error GoTo 0
Next
On Error Resume Next: CommandBarItem.Reset: On Error GoTo 0
Next

Dim Mymenubar As CommandBar

Set Mymenubar = Commandbar_Id_Set(573)
Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = False
Call Menu_ADD(Mymenubar)

Set Mymenubar = Commandbar_Id_Set(941)
Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = False
Call Menu_ADD(Mymenubar)

Set Mymenubar = Commandbar_Id_Set(1790)
Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = False
Call Menu_ADD(Mymenubar)

End Sub
Sub Menu_ADD(Mymenubar As CommandBar)
Dim Newb As CommandBarControl
Dim SubMenu As CommandBarControl
Set Newb = Mymenubar.Controls.Add()
With Newb
.Caption = "発声を停止"
.OnAction = "MyEndSpeak"
End With

Set Newb = Mymenubar.Controls.Add(Type:=msoControlPopup)
With Newb
.Caption = "スピード"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "10"
.State = False
.OnAction = "Rate10"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "9"
.State = False
.OnAction = "Rate09"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "8"
.State = False
.OnAction = "Rate08"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "7"
.State = False
.OnAction = "Rate07"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "6"
.State = False
.OnAction = "Rate06"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "5"
.State = False
.OnAction = "Rate05"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "4"
.State = False
.OnAction = "Rate04"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "3"
.State = False
.OnAction = "Rate03"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "2"
.State = False
.OnAction = "Rate02"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "1"
.State = False
.OnAction = "Rate01"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "0"
.State = False
.OnAction = "Rate00"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-1"
.State = False
.OnAction = "Rate_01"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-2"
.State = False
.OnAction = "Rate_02"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-3"
.State = False
.OnAction = "Rate_03"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-4"
.State = False
.OnAction = "Rate_04"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-5"
.State = False
.OnAction = "Rate_05"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-6"
.State = False
.OnAction = "Rate_06"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-7"
.State = False
.OnAction = "Rate_07"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-8"
.State = False
.OnAction = "Rate_08"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-9"
.State = False
.OnAction = "Rate_09"
End With
Set SubMenu = Newb.Controls.Add
With SubMenu
.Caption = "-10"
.State = False
.OnAction = "Rate_10"
End With

End Sub


Function Commandbar_Id_Set(MyId As Long) As CommandBar
Dim MyCommandBars As CommandBars
Dim Mymenubar As CommandBar

Set MyCommandBars = Application.CommandBars

For Each Mymenubar In MyCommandBars
If Mymenubar.Id = MyId Then
Set Commandbar_Id_Set = Mymenubar
End If
Next

End Function

Sub MyEndSpeak()
Dim Mymenubar As CommandBar
Call SlideMaster.RequestStop
DoEvents
Set Mymenubar = Commandbar_Id_Set(1790)
Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = True
Set Mymenubar = Commandbar_Id_Set(941)
Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = True
Set Mymenubar = Commandbar_Id_Set(573)
Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = True
DoEvents
End Sub


Sub Rate10()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("10").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("10").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("10").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp10")
SaveVariable tmpPath, saveData

End Sub
Sub Rate09()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("9").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("9").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("9").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp9")
SaveVariable tmpPath, saveData



End Sub
Sub Rate08()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("8").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("8").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("8").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp8")
SaveVariable tmpPath, saveData




End Sub
Sub Rate07()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("7").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("7").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("7").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp7")
SaveVariable tmpPath, saveData




End Sub
Sub Rate06()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("6").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("6").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("6").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp6")
SaveVariable tmpPath, saveData




End Sub
Sub Rate05()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("5").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("5").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("5").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp5")
SaveVariable tmpPath, saveData





End Sub
Sub Rate04()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("4").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("4").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("4").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp4")
SaveVariable tmpPath, saveData





End Sub
Sub Rate03()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("3").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("3").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("3").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp3")
SaveVariable tmpPath, saveData




End Sub
Sub Rate02()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("2").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("2").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("2").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp2")
SaveVariable tmpPath, saveData




End Sub
Sub Rate01()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("1").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("1").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("1").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp1")
SaveVariable tmpPath, saveData




End Sub
Sub Rate00()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("0").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("0").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("0").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp0")
SaveVariable tmpPath, saveData





End Sub

Sub Rate_10()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-10").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-10").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-10").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-10")
SaveVariable tmpPath, saveData




End Sub
Sub Rate_09()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-9").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-9").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-9").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-9")
SaveVariable tmpPath, saveData





End Sub
Sub Rate_08()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-8").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-8").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-8").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-8")
SaveVariable tmpPath, saveData





End Sub
Sub Rate_07()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-7").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-7").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-7").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-7")
SaveVariable tmpPath, saveData




End Sub
Sub Rate_06()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-6").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-6").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-6").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-6")
SaveVariable tmpPath, saveData





End Sub
Sub Rate_05()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-5").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-5").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-5").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-5")
SaveVariable tmpPath, saveData





End Sub
Sub Rate_04()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-4").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-4").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-4").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-4")
SaveVariable tmpPath, saveData





End Sub
Sub Rate_03()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-3").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-3").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-3").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-3")
SaveVariable tmpPath, saveData



End Sub
Sub Rate_02()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-2").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-2").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-2").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-2")
SaveVariable tmpPath, saveData



Debug.Print LoadVariable(tmpPath)(1)

End Sub
Sub Rate_01()
Dim Mymenubar As CommandBar
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-1").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-1").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-1").State = True

Dim tmpPath As String
tmpPath = Environ$("tmp") & "\vba_temp.bin"
saveData = Array(LoadVariable(tmpPath)(0), "sp-1")
SaveVariable tmpPath, saveData




End Sub
Sub MyState(Mymenubar As CommandBar)

Mymenubar.Controls("スピード").Controls("10").State = False
Mymenubar.Controls("スピード").Controls("9").State = False
Mymenubar.Controls("スピード").Controls("8").State = False
Mymenubar.Controls("スピード").Controls("7").State = False
Mymenubar.Controls("スピード").Controls("6").State = False
Mymenubar.Controls("スピード").Controls("5").State = False
Mymenubar.Controls("スピード").Controls("4").State = False
Mymenubar.Controls("スピード").Controls("3").State = False
Mymenubar.Controls("スピード").Controls("2").State = False
Mymenubar.Controls("スピード").Controls("1").State = False
Mymenubar.Controls("スピード").Controls("0").State = False
Mymenubar.Controls("スピード").Controls("-1").State = False
Mymenubar.Controls("スピード").Controls("-2").State = False
Mymenubar.Controls("スピード").Controls("-3").State = False
Mymenubar.Controls("スピード").Controls("-4").State = False
Mymenubar.Controls("スピード").Controls("-5").State = False
Mymenubar.Controls("スピード").Controls("-6").State = False
Mymenubar.Controls("スピード").Controls("-7").State = False
Mymenubar.Controls("スピード").Controls("-8").State = False
Mymenubar.Controls("スピード").Controls("-9").State = False
Mymenubar.Controls("スピード").Controls("-10").State = False



End Sub

Private rbIRibbonUI As IRibbonUI ' リボン
Private rbSelectedItemIndex As Integer

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
Dim tmpPath As String
Dim saveData As Variant
Dim loadData As Variant

Static MySex As String
Static MySpeed As String
Static MyValSpeed As Long
tmpPath = Environ$("tmp") & "\vba_temp.bin"
MySex = LoadVariable(tmpPath)(0)
MySpeed = LoadVariable(tmpPath)(1)
Set rbIRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
rbIRibbonUI.Invalidate ' リボンを更新
End Sub
Public Sub speakersSex_getSex(control As IRibbonControl, ByRef returnedVal)
Dim tmpPath As String
Dim loadData As Variant

tmpPath = Environ$("tmp") & "\vba_temp.bin"

returnedVal = LoadVariable(tmpPath)(0)
End Sub
Public Sub speakspeed_Speed(control As IRibbonControl, ByRef returnedVal)


Dim tmpPath As String
Dim loadData As Variant

tmpPath = Environ$("tmp") & "\vba_temp.bin"

returnedVal = LoadVariable(tmpPath)(1)
End Sub


Sub dropDown_onAction(control As IRibbonControl, itemID As String, index As Integer) ' DropDownのクリックした処理
' 引数のcontrolはDropDown、itemIDはitemのid、indexは0から始まるitemの番号
Dim tmpPath As String
Dim saveData As Variant
Dim loadData As Variant
Dim Mymenubar As CommandBar
Static MySex As String
Static MySpeed As String
Static MyValSpeed As Long
tmpPath = Environ$("tmp") & "\vba_temp.bin"
MySex = LoadVariable(tmpPath)(0)
MySpeed = LoadVariable(tmpPath)(1)

Select Case itemID
Case "Male"
MySex = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData

Case "FeMale"
MySex = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData

Case "sp10"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 10

Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("10").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("10").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("10").State = True

Case "sp9"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 9
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("9").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("9").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("9").State = True


Case "sp8"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 8
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("8").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("8").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("8").State = True


Case "sp7"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 7
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("7").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("7").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("7").State = True


Case "sp6"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 6
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("6").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("6").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("6").State = True


Case "sp5"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 5
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("5").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("5").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("5").State = True


Case "sp4"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 4
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("4").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("4").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("4").State = True


Case "sp3"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 3
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("3").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("3").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("3").State = True

Case "sp2"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 2
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("2").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("2").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("2").State = True


Case "sp1"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 1
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("1").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("1").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("1").State = True


Case "sp0"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = 0
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("0").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("0").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("0").State = True


Case "sp-1"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -1
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-1").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-1").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-1").State = True


Case "sp-2"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -2
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-2").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-2").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-2").State = True


Case "sp-3"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -3
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-3").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-3").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-3").State = True


Case "sp-4"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -4
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-4").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-4").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-4").State = True


Case "sp-5"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -5
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-5").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-5").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-5").State = True


Case "sp-6"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -6
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-6").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-6").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-6").State = True


Case "sp-7"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -7
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-7").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-7").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-7").State = True


Case "sp-8"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -8
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-8").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-8").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-8").State = True


Case "sp-9"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -9
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-9").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-9").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-9").State = True


Case "sp-10"
MySpeed = itemID
saveData = Array(MySex, MySpeed)
SaveVariable tmpPath, saveData
MyValSpeed = -10
Set Mymenubar = Commandbar_Id_Set(1790)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-10").State = True
Set Mymenubar = Commandbar_Id_Set(941)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-10").State = True
Set Mymenubar = Commandbar_Id_Set(573)
Call MyState(Mymenubar)
Mymenubar.Controls("スピード").Controls("-10").State = True

End Select

End Sub

Sub SaveVariable(filePath As String, var As Variant)
Dim fNo%: fNo = FreeFile()

Open filePath For Binary As fNo
Put fNo, , var
Close fNo

End Sub

Function LoadVariable(filePath As String) As Variant
Dim fNo%: fNo = FreeFile()

Open filePath For Binary As fNo
Get fNo, , LoadVariable
Close fNo

End Function


Function ValSpeed_Set(MySpeed As String) As Long
Dim MyValSpeed As Long
Select Case MySpeed
Case "sp10"
MyValSpeed = 10
Case "sp9"
MyValSpeed = 9
Case "sp8"
MyValSpeed = 8
Case "sp7"
MyValSpeed = 7
Case "sp6"
MyValSpeed = 6
Case "sp5"
MyValSpeed = 5
Case "sp4"
MyValSpeed = 4
Case "sp3"
MyValSpeed = 3
Case "sp2"
MyValSpeed = 2
Case "sp1"
MyValSpeed = 1
Case "sp0"
MyValSpeed = 0
Case "sp-1"
MyValSpeed = -1
Case "sp-2"
MyValSpeed = -2
Case "sp-3"
MyValSpeed = -3
Case "sp-4"
MyValSpeed = -4
Case "sp-5"
MyValSpeed = -5
Case "sp-6"
MyValSpeed = -6
Case "sp-7"
MyValSpeed = -7
Case "sp-8"
MyValSpeed = -8
Case "sp-9"
MyValSpeed = -9
Case "sp-10"
MyValSpeed = -10
End Select
ValSpeed_Set = MyValSpeed

End Function

<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="OnLoad">

<ribbon>
<tabs>
<tab id="MyTab1" label="オンデマンド資料作成" insertBeforeMso="TabHome">

<group id="EditD" label="読上げ用ノート編集" >
<button id="Note_Replace" label="読替設定​​" imageMso="SpeechMicrophone" onAction="SlideMaster.Note_Replace" size="large" />
<button id="ph_Del_Replace_1_BD6E2" label="読替タグ削除" imageMso="InkEraseMode" onAction="SlideMaster.ph_Del_Replace" size="large" />
<button id="Reg_txt_2_BD6E2" label="読替リスト出力" imageMso="SourceControlCheckOut" onAction="SlideMaster.Reg_txt" size="large" />
<button id="Write_break_time_3_BD6E2" label="一時停止ポイント作成" imageMso="MailMergeResultsPreview" onAction="SlideMaster.Write_break_time" size="large" />
</group>
<group id="mso_c3.6D890" label="読上げテスト" >
<dropDown id="speakersSex" label="音声の性別" getSelectedItemID="speakersSex_getSex" onAction="dropDown_onAction">
<item id="Male" label="男性" />
<item id="FeMale" label="女性" />
</dropDown>
<dropDown id="speakspeed" label="発声スピード" getSelectedItemID="speakspeed_Speed" onAction="dropDown_onAction">
<item id="sp10" label="10" />
<item id="sp9" label="9" />
<item id="sp8" label="8" />
<item id="sp7" label="7" />
<item id="sp6" label="6" />
<item id="sp5" label="5" />
<item id="sp4" label="4" />
<item id="sp3" label="3" />
<item id="sp2" label="2" />
<item id="sp1" label="1" />
<item id="sp0" label="0" />
<item id="sp-1" label="-1" />
<item id="sp-2" label="-2" />
<item id="sp-3" label="-3" />
<item id="sp-4" label="-4" />
<item id="sp-5" label="-5" />
<item id="sp-6" label="-6" />
<item id="sp-7" label="-7" />
<item id="sp-8" label="-8" />
<item id="sp-9" label="-9" />
<item id="sp-10" label="-10" />
</dropDown>
<button id="selection_tts_" label="選択テキスト読上げ" imageMso="ResultsPaneStartFindAndReplace" onAction="SlideMaster.selection_tts" size="large" />
<button id="SpeakNote_Make_test_" label="表示スライドノート読上" imageMso="ResultsPaneStartFindAndReplace" onAction="SlideMaster.SpeakNote_Make_test" size="large" />
</group>
<group id="mso_c1.1FB242" label="スライドショー設定作業" >
<button id="RequestStop_0_1D8436" label="音声ファイル出力" imageMso="SpeechMicrophone" onAction="SlideMaster.RequestStop" size="large" />
<button id="AnimationCustom" label="再生時間設定" imageMso="StartAfterPrevious" onAction="SlideMaster.RequestStop" size="large" />
</group>

</tab>
</tabs>
</ribbon>
</customUI>

<Relationship Id="customUI" Type="http://schemas.microsoft.com/office/2007/relationships/ui/extensibility" Target="customUI/customUI.xml"/>

'*************************************************************
' ドラッグ＆ドロップしたmsgファイルから添付ファイルを抽出し、
' 指定したフォルダに保存するスクリプト
'
' 2015/12/16 @kinuasa
' 2021/07/22 @Nonomura 保存フォルダをVBSのあるフォルダに変更　https://qiita.com/asterisk9101/items/54cdcedb9ef60ea0bb21 @asterisk9101が2015年06月09日に更新
'*************************************************************

Option Explicit

Dim fso '2021/07/22 @Nonomura
set fso = createObject("Scripting.FileSystemObject") '2021/07/22 @Nonomura

Dim strFolderPath '2021/07/22 @Nonomura
strFolderPath = fso.getParentFolderName(WScript.ScriptFullName) '2021/07/22 @Nonomura

Dim Dup '2021/07/22 @Nonomura　重複ファイル名蓄積
Dim list '2021/07/22 @Nonomura
Dim MyFlag '2021/07/22 @Nonomura 重複フラグ
Dim Mydic
Set Mydic = CreateObject("Scripting.Dictionary")

Dup = "削除された添付ファイル,MSGファイル" & vbCrLf '2021/07/22 @Nonomura 重複メッセージ
list = "MSGファイル,添付ファイル" & vbCrLf
MyFlag = 0 '2021/07/22 @Nonomura 重複フラグ


Dim args
Dim olApp
Dim i
'Const SaveFolderPath = "C:\Users\user\Desktop\添付ファイル抽出" '添付ファイルの保存先フォルダ(※要変更) 2021/07/22 @Nonomura ↓に変更
dim SaveFolderPath '2021/07/22 @Nonomura
SaveFolderPath = strFolderPath '2021/07/22 @Nonomura

Set args = WScript.Arguments
If args.Count < 1 Then
MsgBox "msgファイルを当スクリプトファイルにドラッグ＆ドロップしてください。", vbExclamation + vbSystemModal
WScript.Quit
End If

With fso
If .FolderExists(SaveFolderPath) = False Then
MsgBox "添付ファイルの保存先フォルダが見つかりませんでした。" & vbCrLf & _
"処理を中止します。", vbCritical + vbSystemModal
WScript.Quit
End If
Set olApp = CreateObject("Outlook.Application")
For i = 0 To args.Count - 1
If .FileExists(args(i)) = True Then
Select Case LCase(.GetExtensionName(args(i)))
Case "msg" 'msgファイルのみ処理
SaveMsgAttachments olApp, args(i), AddPathSeparator(SaveFolderPath), Mydic, Dup, MyFlag, list, fso '2021/07/22 @Nonomura 引数追加
End Select
End If
Next
olApp.Quit
End With

if MyFlag = 1 then
msgbox "添付ファイルの一部は、ファイル名が同一であったため、上書きされました。" & vbCrLf & _
"重複データ.csvを確認してください。" '2021/07/22 @Nonomura 重複メッセージ

Dim ts
Set ts = fso.CreateTextFile(SaveFolderPath & "\!重複データ.csv", True, True)

ts.Write (Dup) ' 書き込み
ts.Close ' ファイルを閉じる
Set ts = fso.CreateTextFile(SaveFolderPath & "\!添付ファイルリスト.csv", True, True)
ts.Write (list) ' 書き込み
ts.Close ' ファイルを閉じる

End if



MsgBox "処理が終了しました。", vbInformation + vbSystemModal

Private Sub SaveMsgAttachments(ByVal OutlookApp, ByVal MsgFilePath, ByVal SaveFolderPath, ByRef Mydic, ByRef Dup, ByRef MyFlag, ByRef list, ByVal fso) '2021/07/22 @Nonomura 引数追加
Dim itm 'Outlook.MailItem
Dim atc 'Outlook.Attachment
Dim fn

With OutlookApp.GetNamespace("MAPI")
Set itm = .OpenSharedItem(MsgFilePath)
Select Case LCase(TypeName(itm))
Case "mailitem"
If itm.Attachments.Count < 1 Then
MsgBox "添付ファイルがありません。" & vbCrLf & _
"(ファイル名：" & MsgFilePath & ")", vbExclamation + vbSystemModal
Exit Sub
Else
With fso
For Each atc In itm.Attachments
fn = SaveFolderPath & atc.FileName
list = list & .getFileName(MsgFilePath) & "," & atc.FileName & vbCrLf '2021/07/22 @Nonomura
If .FileExists(fn) = True Then
Dup = Dup & atc.FileName & "," & Mydic(atc.FileName) & vbCrLf '2021/07/22 @Nonomura
If Mydic.Exists(atc.FileName) = True Then '2021/07/22 @Nonomura
Mydic.Remove atc.FileName '2021/07/22 @Nonomura
Mydic.Add atc.FileName, .getFileName(MsgFilePath) '2021/07/22 @Nonomura
End If
.DeleteFile fn, True '同名のファイルがあったら事前に削除
End If
If Mydic.Exists(atc.FileName) = False Then '2021/07/22 @Nonomura
Mydic.Add atc.FileName, .getFileName(MsgFilePath) '2021/07/22 @Nonomura
Else '2021/07/22 @Nonomura
MyFlag = 1 '2021/07/22 @Nonomura 重複フラグ
End If '2021/07/22 @Nonomura
atc.SaveAsFile fn
Next
End With
End If
End Select
End With

End Sub

Private Function AddPathSeparator(ByVal s)
If Right(s, 1) <> ChrW(92) Then s = s & ChrW(92)
AddPathSeparator = s
End Function