8月31日　体験版が公開されました　【22年1月22日追記】

申請しました。問題が無ければその内公開されるはずです。
公開されました。よろしくね。
作品名は『She-She』です。
https://www.dlsite.com/maniax/announce/=/product_id/RJ341690.html

……エイプリルフールに公開した記事のアレです。はい。

修正版

直したほうが良さそうな点を修正いたしました。
詳細は下記をご覧ください。

Ver0.031変更点
1.バグ修正
・追加イベントの影響で回想以外で正常なイベントが表示されなくなっていたのを修正
　
Ver0.03変更点
1.変更点
・イベントの差分を2つ追加
・チュートリアルのゴール付近の背景を変更
・2回目以降のチュートリアルでの制限時間を60秒に変更
・ステージ1の地形および背景を変更
・ステージ1の敵配置を微調整（若干難易度を上昇）
・日本語以外で遊んでいる場合に、会話イベント中にTABキーを押すと画面中央に原文が表示される機能を追加
・縦方向の当たり判定を倍に変更
→今回の更新から首の下からつま先までが接触判定となります。
・回想の並び順を変更
・回想のイベント選択画面で表示される画像がイベント差分毎に画像が表示されるよう変更
・一部イベントを調整
・武器を拾った際に画面上部に現在の武器が表示されるよう変更
・一部UIを調整
・一部CGを修正
・Readmeに色々と追加
2.バグ修正
・Ver0.01・Ver0.02で始めた場合に一部イベントを初回のチュートリアルで起こしていないと回想で開放されなくなるバグを修正
・チュートリアルをクリアしてないと針穴に落ちたときに初回チュートリアル用のイベントが必ず発生するバグを修正
・イベント内容を実情に沿ったものへ変更
・スキップ使用時に効果音が一気に流れる現象を対策
・回想のイベント選択が滑りやすい現象を改善
・一部文章を修正
　
Ver0.02変更点
1.変更点
・ステージ内でEscキーを押した時の選択肢に「諦める」コマンドを追加
　諦めるを選ぶと時間切れになった扱いになります。
・バックログを実装
（基本操作）
　方向キー：表示する文章を変更
　キャンセルキー：閉じる
（特殊な操作）
　最新の文章が表示されている時に下キー：キャンセルキーと同様の動作
　サブキー＋方向キー：5回分ずつ移動
　Ctrlキー＋方向キー：一番上、一番下へ移動
　TABキー：言語の変更（バックログ内のみ）
・回想で一部イベントを再生した際にBGMがそのステージの物に変わるよう変更
・チュートリアルのBGMを変更
→ステージ1のBGMが間違って設定されていましたが、BGMの使用箇所自体を変えました。
・一部処理を変更
2.バグ修正
・初回チュートリアルで条件を満たしてもイベントが分岐しないバグを修正
・特定イベントで環境音が止まらない場合があるバグを対策
・特定手順を踏むとステージ内でEscキーを押した際に表示される選択肢が表示されなくなるバグを修正
・一部選択肢の翻訳漏れを修正
・一部文言を修正
　
Ver0.01変更点
1.変更点
・ステージ1に武器を設置
　敵にぶつけると倒せます。
・未開放の差分イベントは回想にて『？？？』と表示されるよう変更
・回想のイベントにて開放済みの場合にもヒント用の内容が表示されるよう変更
・武器を拾った時の効果音を追加
2.バグ修正
・チュートリアルステージにてゲームパッドで武器を拾えないバグを修正
・当たり判定を上方向に18ピクセル調整
・ステージ1で敵にぶつかった際に別のイベントが実行される場合があるバグを修正
・初回限定のイベントが未開放の場合に回想で見られなくなるバグを修正
→セーブデータを引き継いだ場合はロードするだけで閲覧できるよう適用されます。
・各イベントのフラグが適切に立っていない点を修正（体験版単体では進行に支障はきたしません）
・クリア時にコンマ秒が099以下だと.が2つ表示されるバグを修正
・ステージ選択画面でサブキーを押した際に2回押さないとステージ情報が表示されないバグを修正
・初めて回想を開いた際に、条件を満たす事で発生するイベントのみ閲覧していた場合に通常のイベントが開放され、かつ見ている扱いになるバグを修正
→通常の内容が開放されるのは仕様でしたが、面倒な挙動が見つかったのでこの処理自体を消します。

注意

・今回の体験版ではチュートリアルとステージ1のみを遊べます。
　ただし特定の条件を満たす事で起きる予定のイベントは動作しないようにしています。
・体験版のボリュームはイベントを全て見ると15分前後です。
・ゲームパッドにも対応させましたが、当方ゲームパッドを未所持のため動作チェックはできていません。
・日本語OSでは4言語に対応していますが、日本語以外のOSでの動作チェックはしていません。そんな環境ありません。

確認されているバグ（修正不可）

・言語が『中国語』（簡体字・繁体字のいずれか）かつ文章の速度が『即时』以外だとShift-JIS対応外の文字が表示されると少しだけ文章送りが固まる
・敵（正確には当たり判定があるオブジェクト）が一定範囲内に集まりすぎている状態で攻撃するとプレイ環境によっては異常なラグが発生する（9月13日追記）

現在のVerで確認されているバグ・ミス一覧（次回Verで対応）

・一部イベントをステージ内で初めて起こした場合に、主人公の座標によってはCGが横からスクロールされるように表示されてしまう（9月24日追記）
・TABキーをゲームパッドに割り当てられない（9月24日追記、仕様ですが割り当てられるよう変えます）
・設定や回想画面でカーソルを動かした時に効果音が鳴らない場合がある
→作者の環境でも確認できていますが変な部分は見当たらないので環境依存の挙動な気がします。（ここまで10月17日追記）
→画像等の読み込みによる負荷が原因でした。この負荷はどうにもなりませんがSEチャンネルの設定を変えたら対策できました。（10月29日追記）
・キーコンフィグにてゲームパッド用の設定を変更しようとしても操作を受け付けない（11月3日追記）
→環境によっては実質の詰み操作となっていたため、次回更新にて「キーボードの設定中にゲームパッドのボタンを押した場合」と「ゲームパッドの設定中にキーボードのキーを押した場合」は中断されるよう変更いたします。
　現Verでは方向キーか十字ボタンを押すかかスティックを倒す事で設定は初期化されますが進行できます。
・日本語以外でキーコンフィグにて左Ctrlキーを設定した場合に漢字が表示される（11月3日追記）
・キーコンフィグでテンキーを設定した場合に何も表示されない（11月3日追記）
→可能な限り直しますが作者の環境にて一部確認できないキーがあります。
・キーコンフィグで0キーとOキーが同じ文字にしか見えない（11月3日追記）
→O（オー）キーのみ小文字に変更します
・キーコンフィグでキーボードの設定を変えた場合に決定キー・キャンセルキー・サブキーに同じボタンが設定される場合があり、方向キーを動かしたりコンフィグを開く度に重複する項目の設定が変わる（11月16日追記）
→初期Verから存在してるバグで応急処置はしていましたが原因が判明しました。この3つのキーは同じ内容が入ると自動で入れ替わるウディタ本体の仕様が原因でした。
・既読イベントを「飛ばす」で飛ばした後に別のイベントを初めて閲覧すると、既読イベントで「飛ばさない」を選ぶまでイベントが再生されなくなる（回想で閲覧可）（11月30日追記）
・段差がある場所で登るように進んだ場合にEscキーを除いた一切の操作を受け付けなくなる場合がある（1月22日追記）

今後のアップデートで対応予定

・表示に関係するバグへの臨時対応として、体験版でもデータ修正機能を使えるようにする（9月26日追記）
→公式チートです。困ったり詰んだらお使いください。体験版でステージ3以降を選べるようにしたらセーブデータを消します。
・ステージ1の説明が不十分（9月28日追記）
→敵にぶつかったらいけない旨の説明が無かったので直します。ついでにチュートリアルも見送っていた会話要素を追加します。
・BGMの音量を変えると環境音の音量も変わる（10月17日追記）
→そういう風に作っているので仕様ではありますが、次回の更新で個別に変えられるよう変更いたします。
・ゲームパッドでの操作が不便、各ボタンに1つしか割り当てられないのでボタンが足りない（11月12日追記）
→次回の更新にて1つのボタンを複数の機能に割り当てられるよう変更いたします。
　ただし一部機能を同じボタンに割り当てるとバグりますが仕様とさせていただきます。

修正済みのバグ

（Ver0.031）
・チュートリアルの時間切れイベントが条件を満たしても初回イベントのまま
・チュートリアルでジャンプで落ちるとステージ1の通常イベントが再生される
・ステージ1で穴に落ちるとチュートリアルのイベントが再生される
（Ver0.03）
・Ver0.01、Ver0.02にて始めた場合に、一部イベントを初回のチュートリアルで起こしていないと回想で開放されなくなる
・チュートリアルをクリアしてないと針穴に落ちたときに初回チュートリアル用のイベントが必ず発生する
（Ver0.02）
・言語を日本語以外にした場合にステージ中でEscキーを押した際の選択肢が翻訳されていない
・イベントで環境音が止まらない場合がある
→ステージ選択画面に戻ってからF12キーを2秒間押すか、設定から文章の速度を『瞬時』にして回想で同じイベントを再生してからスキップすると止まります。
・言語が繁体字の場合に一部イベントで不要な文字が表示される箇所がある
・言語を日本語以外にした場合に2回目以降のスキップ用選択肢が翻訳されていない
・特定手順を踏むとステージ内でEscキーを押した際に表示される選択肢が表示されなくなる
・初回チュートリアルで条件を満たしてもイベントが分岐しない
（Ver0.01）
・当たり判定が想定している所より下にある
・チュートリアルステージにてゲームパッドで武器を拾えない
・各イベントのフラグが適切に立っていない（体験版単体では進行に支障はきたしません）
・クリア時にコンマ秒が099以下だと.が2つ表示される
・ステージ1で敵にぶつかった際に別のイベントが実行されることがある
・初回限定のイベントを見逃すと回想で再生できなくなる
→特定イベントを発生させずチュートリアルクリア後すぐに回想を開いた場合に発生します（9/2追記）
→修正したはずが変数の設定ミスで保存されていませんでした。（9月12日追記）
・ステージ選択画面でサブキーを2回押さないとステージ情報が表示されない
・初めて回想を開いた際に、条件を満たす事で発生するイベントのみ閲覧していた場合に通常のイベントが開放され、かつ見ている扱いになる（仕様でしたが今後面倒なことになるので修正しました）

作者側で確認している、起こる可能性のあるバグ

（もし最新Verで確認できましたら直前の操作を具体的にご報告いただけると助かります。
・ステージ1にて、武器を取った後に敵を何体か倒すと、敵にぶつかった際に敵が消えイベントが発生しない
→0.01にて修正を試みました。
・ステージに入るとすぐにイベントが始まることがある
→0.01にて修正を試みました。
　調べた限りでは、上のバグが起きてる時にEscキーを押すことがトリガーのようでした。

Q&A（何かあれば追加）

Q.セーブ方法
A.オートセーブです。ステージ選択画面に入った時と、おうちで設定を変更するとセーブされます。
Q.How to change the language
A.おうち→設定→言語（Or press O key.）
Q.翻訳について
A.英語と簡体字はDeepLを、繁体字はDeepLが未対応なのでGoogle翻訳を使用しました。
　ウディタでの中国語実装(ゴリ押し)についてはこちらをご覧ください。

ご意見やご感想、バグ報告など、些細な事でも構いませんのでお気軽にコメントへお願いいたします。
I look forward to your feedback.

VBAを活用してウディタで中国語を表示する方法

（21/8/31執筆、9/9修正）

備考

・翻訳支援ツールが製作中との事ですのでそちらが販売されるまでの暫定的な対応です。
・フォントの利用規約を十分確認してください。今回使用しているMSゴシック及びMSPゴシックは画像として配布さえしなければ問題ないフォントの筈です。
・触り始めて5ヶ月のクソコードです。他の方が公開されているサンプルコードを参考にしました。

本題

1年半くらい前の記事ではウディタを用いた変換用の記号への変換と表示について書きましたが、今回は最近裏で覚えたVBAを用いた内容です。
予定には無かったのですが、7月にテキスト画像の背景を透明にして保存する簡単な方法という記事を見つけた結果として今回の方法と完全な実装が実現しました。
この場をお借りしてお礼申し上げます。

フォントの取得

今回の方法ではcsvファイルに格納した文字列を使用します。
私は https://uic.jp/charset/supported_list/ 様から取得しましたが、文字の被り等を考えると後で楽できるようUnicodeの文字コードを取得したほうが良いです。
今回は昔に用意した中国語用の文字コードを使用します。

（サンプルコード）
Sub フォント出力()
Application.ScreenUpdating = False
Dim code As String
code = InputBox("取得元の言語を入力（chs,cht）")
Dim fold As String
'保存先フォルダを指定

If code = "chs" Then
code = "chslist.xlsx"
fold = "chs"
ElseIf code = "cht" Then
code = "chtlist.xlsx"
fold = "cht"
Else
MsgBox "エラーが発生しました。処理を終了します。"
End
End If

'エラー対策（既にリストが開かれていないかの確認）
Dim wb As Workbook, flag As Boolean
For Each wb In Workbooks
If wb.Name = code Then
flag = True
Exit For
End If
Next wb
'開かれてない時だけ開く
If Not flag Then
Workbooks.Open Filename:= _
ThisWorkbook.Path & "/" & code
End If

'雑に変数宣言（細かな設定を弄るならここで）
Dim size As Integer
size = 14

'まずフォルダを作る
If Dir(fold & size, vbDirectory) = "" Then
MkDir fold & size
End If

'下の文字数を減らす為にワークシート名を全て指定
Dim filei As String
filei = "Book2"
Dim file As String
'xlsmから開いた場合と実行後のhtmの場合があるので両方に対応

flag = False
For Each wb In Workbooks
If wb.Name = "Book2.xlsm" Then
flag = True
Exit For
End If
Next wb

If flag = True Then
file = filei & ".xlsm"

'fileをアクティブに
Windows(file).Activate
'xlsmなら一度保存してhtmにする
'警告非表示
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= ＿
ThisWorkbook.Path & "\Book2.htm", ＿
FileFormat:=xlHtml, ReadOnlyRecommended:=False, CreateBackup:=False
End If
'file名を置き換え
file = filei & ".htm"

'ワークシートの指定はアクティブシートしか反映されないので宣言前にActivateを挟む
Windows(code).Activate
Dim 保存 As Worksheet
Set 保存 = Worksheets("Sheet1")

Dim mes As String
Dim x, y As Long
Dim x16 As String
Dim savef As String

'フォントサイズに応じてテキストボックスのサイズを調整
Windows(file).Activate
If size = 24 Then
With ActiveSheet.Shapes.Range(Array("TextBox 1"))
.Width = 25.5118110236
.Height = 25.5118110236
End With
ElseIf size = 14 Then
With ActiveSheet.Shapes.Range(Array("TextBox 1"))
.Width = 13.8897637795
.Height = 13.8897637795
End With
End If

'途中から再開用
Dim r As Long
r = 2

'動作チェックのため途中で止める
For y = r To Range("a2").End(xlDown).Row
' For y = 2 To 2

Windows(code).Activate
x16 = Cells(y, 1).Value

For x = 2 To 17
Windows(code).Activate
mes = 保存.Cells(y, x).Value
If mes = "" Then
GoTo nx
End If

'保存名を設定（一番上にあるのでそれを利用）
savef = x16 & Cells(1, x)

'元のシートに戻ってテキストボックスに貼り付け
Windows(file).Activate
ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
'文字を指定
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = mes
'書式設定
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).ParagraphFormat. _
FirstLineIndent = 0
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font
'色
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.Transparency = 0
.Fill.Solid
'サイズ
.size = size
.Name = "+mn-lt"
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
End With
Application.EnableEvents = False

'警告非表示
Application.DisplayAlerts = False
'保存、ThisWorkbook.Pathはこのブックの保存場所
ActiveWorkbook.SaveAs Filename:= ＿
ThisWorkbook.Path & "\Book2.htm", ＿
FileFormat:=xlHtml, ReadOnlyRecommended:=False, CreateBackup:=False
FileCopy ThisWorkbook.Path & "/book2.files/image001.png", ThisWorkbook.Path & "/" & fold & size & "/" & savef & ".png"

file = "Book2.htm"

'空白の場合の飛ばし先
nx:
Next
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Shift-JISの文字を含めた全ての文字を取得するコードでした。
Shift-JIS以外の文字のみにしたい場合は以下の部分を変えてください。
（変更前）
mes = 保存.Cells(y, x).Value
If mes = "" Then
GoTo nx
End If

（Shift-JISの文字を弾くよう変更した場合）
mes = 保存.Cells(y, x).Value
If mes = "" Then
GoTo nx
ElseIf mes <> "?" And _
Asc(mes) = Asc("?") Then
Else
GoTo nx
End If

問題が起こり途中で止まらなければ6時間ほどで保存用フォルダに全ての文字のpng画像が保存されます。
私の環境では1度固まってました。

変換用記号への変換・復号

Excelの該当箇所にコピーして実行すると変換と復号が行われるコードです。

Sub 文章置換()
Application.ScreenUpdating = False

Windows("呼出元.xlsm").Activate
Worksheets("置換").Select
Range("A2", Range("a2").End(xlDown)).Copy
Range("B2").PasteSpecial
Range("C2").PasteSpecial
Application.CutCopyMode = False

Dim code As String
code = InputBox("取得元の言語を入力（chs,cht）")
Dim fold As String
'保存先フォルダを指定

If code = "chs" Then
code = "chslist.xlsx"
fold = "chs"
ElseIf code = "cht" Then
code = "chtlist.xlsx"
fold = "cht"
Else
MsgBox "エラーが発生しました。処理を終了します。"
End
End If
'エラー対策（既にリストが開かれていないかの確認）
Dim wb As Workbook, flag As Boolean
For Each wb In Workbooks
If wb.Name = code Then
flag = True
Exit For
End If
Next wb
'開かれてない時だけ開く
If Not flag Then
Workbooks.Open Filename:= _
ThisWorkbook.Path & "/" & code
End If

Dim 行数 As Long
行数 = Range("a2").End(xlDown).Row
Dim 先頭 As String
Dim x As Long
Dim y As Long
Dim 保存 As String

Dim ループ As Long
For ループ = 2 To 行数

Do Until Cells(ループ, 2) = ""
先頭 = Mid(Cells(ループ, 2), 1, 1)
If 先頭 <> "?" And _
Asc(先頭) = Asc("?") Then

Windows(code).Activate
Cells.Find(What:=先頭, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= ＿
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False ＿
, MatchByte:=False, SearchFormat:=False).Activate
x = ActiveCell.Column
y = ActiveCell.Row
保存 = Cells(y, 1).value & Cells(1, x).value

Windows("呼出元.xlsm").Activate
'機種依存文字を置き換える
Range("A2", Range("a2").End(xlDown)).Offset(0, 2).Select
Selection.Replace What:=先頭, Replacement:="\" & fold & "[" & 保存 & "]", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ＿
ReplaceFormat:=False

End If
'処理済みの文字を消す
Range("A2", Range("a2").End(xlDown)).Offset(0, 1).Select
Selection.Replace What:=先頭, Replacement:="", LookAt:=xlPart, ＿
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ＿
ReplaceFormat:=False
Loop

Next
Application.ScreenUpdating = True
End Sub

文章の復号は上の内容より厄介です。

Sub 文章復号()
Application.ScreenUpdating = False

Windows("呼出元.xlsm").Activate
Worksheets("置換").Select
Range("A2", Range("a2").End(xlDown)).Copy
Range("B2").PasteSpecial
Range("C2").PasteSpecial
Application.CutCopyMode = False

Dim code As String
code = InputBox("取得元の言語を入力（chs,cht）")
Dim fold As String
'保存先フォルダを指定

If code = "chs" Then
code = "chslist.xlsx"
fold = "chs"
ElseIf code = "cht" Then
code = "chtlist.xlsx"
fold = "cht"
Else
MsgBox "エラーが発生しました。処理を終了します。"
End
End If
'エラー対策（既にリストが開かれていないかの確認）
Dim wb As Workbook, flag As Boolean
For Each wb In Workbooks
If wb.Name = code Then
flag = True
Exit For
End If
Next wb
'開かれてない時だけ開く
If Not flag Then
Workbooks.Open Filename:= _
ThisWorkbook.Path & "/" & code
End If

Dim 行数 As Long
行数 = Range("a2").End(xlDown).Row
Dim 先頭 As String
Dim x, y As Long
Dim 保存 As String
Dim 置換 As String
Dim ax, ay As String
Dim folen As Integer
folen = Len(fold)

Dim ループ As Long
For ループ = 2 To 行数

Do Until Cells(ループ, 2) = ""
先頭 = Mid(Cells(ループ, 2), 1, folen + 2)
If 先頭 = "\" & fold & "[" Then '一致するなら次の4文字を3文字と1文字で取得 ay = Mid(Cells(ループ, 2), folen + 3, 3) '+1 ax = Mid(Cells(ループ, 2), folen + 6, 1) 'folen +2 + 3 +1 '先頭を]までに置き換える
先頭 = Mid(Cells(ループ, 2), 1, folen + 7) 'folen + (2+4+1)

Windows(code).Activate
Range("a2", Range("a2").End(xlDown)).Select
Cells.Find(What:=ay, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= ＿
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False ＿
, MatchByte:=False, SearchFormat:=False).Activate
y = ActiveCell.Row

'0が入る場合に正常に処理されないので例外
If ax <> "0" Then
Range("b1", Range("b1").End(xlToRight)).Select
Cells.Find(What:=ax, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= ＿
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False ＿
, MatchByte:=False, SearchFormat:=False).Activate
x = ActiveCell.Column

Else
x = 2

End If

保存 = Cells(y, x).value

Windows("呼出元.xlsm").Activate
'機種依存文字を置き換える
Range("A2", Range("a2").End(xlDown)).Offset(0, 2).Select
Selection.Replace What:=先頭, Replacement:=保存, LookAt:=xlPart, ＿
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ＿
ReplaceFormat:=False

Else
'異なるなら1文字だけ取得し削除
先頭 = Mid(Cells(ループ, 2), 1, 1)

End If

'処理済みの文字を消す
Range("A2", Range("a2").End(xlDown)).Offset(0, 1).Select
Selection.Replace What:=先頭, Replacement:="", LookAt:=xlPart, ＿
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ＿
ReplaceFormat:=False

Loop

Next
Application.ScreenUpdating = True
End Sub

上のコードは、例として\chs[FFF0]という変換用の記号を復号する場合に、『\』、『chs』、『[』、『FFF』、『0』、『]』という6つのブロックに分けて置換を行うというやり方です。
実際に動かすとこんな風になります。（置換）

あとはウディタ側で\chs[ と \cht[ を\img[(ファイルパス)　へ置き換えるように書いて文章を表示させる前に処理を挟めば完成です。

以上ですが、全部の文字を入れると約38MBになり、また1度の暗号化作業に30分ほど掛かります。
とても扱いにくい代物ですので、先にゲーム名を合わせた状態で暗号化フォルダを限定するからフォントが入っているフォルダを.wolf形式に変換し、その.wolfファイルを開発用フォルダに入れ元のフォルダは別の所に移しておく事をお勧めします。
ゲーム内ではちゃんと表示され、またゲームデータの作成に掛かる時間も短縮できます。