エクセル上での疑似コメントビューワー
閉じる
閉じる

新しい記事を投稿しました。シェアして読者に伝えましょう

×

エクセル上での疑似コメントビューワー

2016-10-21 23:57
  • 2


事の発端はねもうすちゃんねる掲示板にあった、こちら↓の書き込み。
264096 : ななしのよっしん :2016/10/20(木) 11:12:29 ID: aptRd5k2vq
初めてVBAマクロ触ったから変なところあるかもしれないけどソース貼ります
簡単なので素人でも読めると思います。自由に使ってください

Sub sample()

Dim waitTime As Variant
Dim t1 As Date
Dim t2 As Date
Dim delt As Date

For i = 1 To 100 '適当にループさせる(コメント数分)
Windows("book1.xlsm").SmallScroll Down:=1 'コメントを読み込んだエクセルウィンドウの名前を入れる
t1 = Range("A" & Format(i + 3)).Value '開始前3行余白を作ったので+3した
t2 = Range("A" & Format(i + 4)).Value '前の行の一つ先を読む
delt = t1 - t2
waitTime = Now + TimeValue(delt)
Application.Wait waitTime
Next i

End Sub

これ使っても動画時間分画面キャプチャしないとだから、かなり時間がかかるのが問題
あと、同じ秒に打たれたコメントが多いと表示できない。これは解決案があるけどまだ実装できてない
その後、
264127 : ななしのよっしん :2016/10/20(木) 12:49:11 ID: Ak4Wn6xORC
>>264096
あまりうまい書き方ではないですが、同じ秒にあるコメントの処理を追加してみました

Sub sample()

Dim waitTime As Variant
Dim t1 As Date
Dim t2 As Date
Dim delt As Date

For i = 1 To 100 '適当にループさせる(コメント数分)
Windows("book1.xlsm").SmallScroll Down:=1 'コメントを読み込んだエクセルウィンドウの名前を入れる
t1 = Range("A" & Format(i + 3)).Value '開始前3行余白を作ったので+3した
t2 = Range("A" & Format(i + 4)).Value '前の行の一つ先を読む
delt = t2 - t1
waitTime = Now + TimeValue(delt)

'追加部分
If delt = 0 Then
Application.Wait [Now() + "0:00:00.2"] '"0:00:00.2"部の数値書き換えでコメント表示速度変化
Else
Application.Wait waitTime
End If
'追加部分終わり

Next i

End Sub

という流れがありました。
このまま掲示板に埋まってしまうのはもったいないので、このマクロの使用方法を記述して情報を共有したいと思います。

この記事の冒頭の動画は自分が使いやすいように適当に手を加えて改変したものです。
非常に汚い。
Sub sample()

Dim waitTime As Variant
Dim waitTime2 As Variant
Dim t1 As Date
Dim t2 As Date
Dim t3 As Date
Dim delt As Date
Dim delt2 As Date
Dim count As Integer

count = 0
For i = 1 To 500 '適当にループさせる(コメント数分)
Windows("疑似コメビュ.xlsm").SmallScroll Down:=1 'コメントを読み込んだエクセルウィンドウの名前を入れる
t1 = Range("A" & Format(i + 12)).Value '開始前12行余白を作ったので+12した
t2 = Range("A" & Format(i + 13)).Value '前の行の一つ先を読む
t3 = Range("A" & Format(i + 14)).Value
delt = t2 - t1
delt2 = [t2 - t1 - "0:00:01"]
waitTime = Now() + TimeValue(delt)
waitTime2 = Now() + TimeValue(delt2)

If count = 50 Then
Application.Wait waitTime2
count = 0
ElseIf delt = 0 Then
Application.Wait [Now() + "0:00:00.02"] '" "部の数値書き換えでコメント表示速度変化
count = count + 1
Else
Application.Wait waitTime
End If
Next i

End Sub
  • 使用方法
まずは必要なソフトから。
  1. Microsoft Excel
  2. NiconamaCommentViewer(コメビュ)
  3. キャプチャソフト
  4. 動画編集ソフト
ちなみに自分の環境は、
  1. Microsoft Excel 2010
  2. コメビュ
  3. Bandicam(有料)
  4. AviUtl
です。

大まかな流れは、
①エクセルに必要なデータをコメビュから入手
②データをエクセル内に書込む
③エクセルのマクロを実行
④実行の様子をキャプチャソフトで録画
⑤動画編集ソフトで編集し動画に合成

こんな感じ。
早速細かく説明してまいります。
①エクセルに必要なデータをコメビュから入手
 ・コメント書き込み時間のデータ

7:20:23
7:20:25
7:20:25
7:20:27
7:20:28
7:20:28
7:20:30
7:20:30
7:20:30
7:20:31
7:20:31

こんなかんじの.txtファイル
 ・コメント内容のデータ


やああああああああああああ
やあ
なんに
yaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
おはよう
やあああああああああああああああ
やるおおおおおおおおおおおおおおおおおお
やあ
yaa
やああああああああああああああああああああああああああああ
まじかよ
やああああああああああああああああああああああああ
!・。・?
やああああああああああああああああああああああああ
あーあアリーナかよ
おはよう

こんな感じの.txtファイル

この二つはコメビュから入手することができます

コメビュの設定をいじると時間のみ表示、コメントのみの表示ができるようになっている。(画像は時間&コメント表示)
これを、
ファイル(F)→テキスト形式で保存(T)
でテキストデータとして入手することができます。

②データをエクセル内に書込む


時間のテキストデータをA列に、コメントのテキストデータをB列に書き込みます。

※追記 10/22 元祖マクロ製作者さんより 
コメビュからテキストデータを入手すると追い出しコマンド"/hb ifseetno 0"や、NGコマンド"※ NGコメントです ※"が見受けられます。
これらは本マクロを動かす上で障害になるのでセル上から排除しなければなりません。そのため下記のマクロをあらかじめ実行しておくとよいです。
-------------------------------------------------------------------------------------
Sub DelLines()
Dim R As Range
Do
Set R = ActiveSheet.Range("B:B").Find(What:="/hb", LookAt:=xlPart)
If R Is Nothing Then Exit Sub
R.EntireRow.Delete
Loop
Do
Set R = ActiveSheet.Range("B:B").Find(What:="※ NGコメントです ※", LookAt:=xlPart)
If R Is Nothing Then Exit Sub

R.EntireRow.Delete
Loop
End Sub

-------------------------------------------------------------------------------------



③エクセルのマクロを実行
エクセルの[開発]タブから[マクロ]→マクロ選択→[実行]でエクセル上で疑似コメビュが動作します。

④実行の様子をキャプチャソフトで録画
キャプチャソフトにより手順は違ってくると思います。
自分の使っているBandicamではデスクトップ上の範囲を指定してキャプチャができるため、それを利用しています。

⑤動画編集ソフトで編集し動画に合成

編集の例です。
文字の大きさ等の細かい部分はエクセル側から指定できます。



以上になります。

コメビュ形式はコメントを流す形式の動画よりも画質が落ちにくい(低ビットレートでも文字が潰れない)点がメリットです。
しかし、このエクセルマクロを利用した疑似コメビュは録画に時間がかかってしまうデメリットもあります。
このあたりが今後の課題でしょうか。

ソースコードの簡単な解説も入れようと思いましたがめんどくさくなったので気が向いたらやります。

ここで使われているマクロはまだまだ改良の余地があると思います。
自分自身、普段は全くVBAを触らないので初心者です。
良い案、改良点がありましたら是非コメントにお願いします。


まとめ

メリット :低ビットレートでも文字が崩れにくい
デメリット:時間がかかる







広告
×
掲示板に投稿した者です。非常に分かりやすくまとめて頂き感謝しております。
大したものではありませんが、追い出しコメントや、NGコメントが邪魔になると思うので
それらを一括削除するために使っていたマクロを貼らせていただきます。

Sub DelLines()
Dim R As Range
Do
Set R = ActiveSheet.Range("B:B").Find(What:="/hb", LookAt:=xlPart)
If R Is Nothing Then Exit Sub
R.EntireRow.Delete
Loop
Do
Set R = ActiveSheet.Range("B:B").Find(What:="※ NGコメントです ※", LookAt:=xlPart)
If R Is Nothing Then Exit Sub
R.EntireRow.Delete
Loop
End Sub
34ヶ月前
×
>>1
わざわざ記事を見つけて書き込んでいただき、ありがとうございます。大変助かります。
コメントにあるソースコードは記事に追加しておきますね!
34ヶ月前
コメントを書く
コメントをするには、
ログインして下さい。