ナナミのブロマガ

ソース公開ページ#001_画像オートシェイプを色反転する(おまけ:画像削除処理付き)

2015/10/16 00:20 投稿

  • タグ:
  • Excel
  • エクセル
  • マクロ
  • VBA
Excelマクロの画像オートシェイプの色反転処理のソースを公開します。
 処理内容やファイルダウンロードはこちらの紹介ページに記載しています。
 ソースは大きく以下5つに分けて記載します。
 ダウンロードファイルにあるExcelマクロファイルはモジュール構成をこれと同じにしています。
ソース構成
  1. a_パブリック変数・定数
  2. b_ユーザー定義関数
  3. c_画像色反転
  4. d_画像削除
  5. ReversePictureColor(VBS)

a_パブリック変数・定数

 ここではPublic変数、Public定数を記載しています。と言っても実際に定義したのはPublic定数だけです。
 具体的にはVBSファイル名です。デフォルトは「ReversePictureColor.vbs」ですが、VBSファイル名を変更したい場合はここを変えると反映されます。
ソース
Option Explicit

'**********
' 定数
'**********
Public Const VBS_NAME = "ReversePictureColor.vbs" 'VBSファイル名

b_ユーザー定義関数

 ここではメイン処理で多く使用する自作ユーザー定義関数を記載しています。
ここで記載しているのは以下2つです。

Sleep関数の宣言
対象プロセスが実行中であるか判定するユーザー定義関数

 Sleep関数宣言は念の為32BitExcel、64BitExcelどちらでも使用できる記述にしています。私はどんな環境でも使用できるように大体こういった記述の仕方をします。実はSleep関数はこのVBA処理では結局使わずじまいだったんですが(VBS側では使用しています)、紹介ページの注意事項で記載したように画像の切り取り・貼り付けはマシンスペックや画像の大きさに依存するので、人によっては使うかもしれないと思い、残しています。
 もう一つのユーザー定義関数ですが、これはこちらのWebページのソースをほぼ流用させて頂いております。今回のマクロ処理では外部ツールであるペイントを活用する為、この処理は色んな所で活躍しています。Webページ側のソースではコメント記述はありませんが、自分で後で処理内容を思い出せるよう、自分なりにコメントを記述しています。
ソース
Option Explicit
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Win32APIのSleep関数使用を宣言
' Sleep関数:マクロ処理を指定した時間(ミリ秒単位)だけ待機させる
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#If Win64 Then
''■64bitExcelの場合
Public Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr)
#Else
''■32bitExcelの場合
Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If

'------------------------------------------------------------
' 処理名 |対象プロセスが実行中であるか判定するユーザー定義関数
'------------------------------------------------------------
' 概要 |・引数を検索プロセス名とする。
' |・実行中プロセス内に同名プロセスが存在するか判定する。
' |・戻り値はBoolean型とする。
'------------------------------------------------------------
' 引数 |検索プロセス名
' 戻り値 |実行中:True、実行中でない:False
' 作成 |2015.10.02
' 作成者 |ナナミ
' Ver |1.00
'------------------------------------------------------------
Public Function TaskExists(ByVal ProcessName As String) As Boolean

Dim Locator 'WMIオブジェクト
Dim Server 'コネクトサーバ格納用オブジェクト
Dim objSet 'プロセス取得用
Dim obj '各々のプロセスに対する処理用

'************************************************************
' 戻り値の初期値設定(False)
'************************************************************
TaskExists = False


'************************************************************
' オブジェクト作成
'************************************************************
Set Locator = CreateObject("WbemScripting.SWbemLocator") 'WMIオブジェクト作成
Set Server = Locator.ConnectServer '自PCに接続
Set objSet = Server.ExecQuery("Select * From Win32_Process") '実行中プロセスを取得


'************************************************************
' 対象プロセスを検索
'************************************************************
For Each obj In objSet
''■対象プロセスが実行中の場合、「True」とし処理を抜ける
If obj.Caption = ProcessName Then
TaskExists = True
Exit For
End If
Next


'************************************************************
' 使用した各種オブジェクトの解放
'************************************************************
Set obj = Nothing
Set objSet = Nothing
Set Server = Nothing
Set Locator = Nothing

End Function

c_画像色反転

 いよいよメイン処理です。大まかな処理内容は紹介ページのフローチャートを参照して頂ければと思います。
 このモジュールには以下4つを記述しています。

Excelファイルの全画像を色反転する処理
アクティブシートの全画像を色反転する処理
VBSを実行する処理
対象プロセスを終了させる処理

 ①と②はメイン処理です。①が全シート用、②がアクティブシート用です。③と④は①・②どちらでも使用しています。
 ③はVBSに渡す引数が無しという前提にしています。③だけ使用したいという方はこの処理中の「■VBSに渡す引数を作成」の箇所が引数作成処理となっていますので、そこを修正して下さい。
 ④はユーザー定義関数のプロセス実行中判定処理を少しだけアレンジして作成しました。この方法だといちいち「閉じてもよろしいですか?」といった確認ダイアログが出ないのでマクロ処理としては楽ですね。
 因みにエラー処理は敢えて入れないことにしました。エラー処理とはここでは「On Errorステートメント」を指します。エラー時にどういうことをさせたいかは人それぞれだからです。
ソース
Option Explicit

'------------------------------------------------------------
' 処理名 |Excelファイルの全画像を色反転する処理
'------------------------------------------------------------
' 概要 |・Excelファイル上の全画像オートシェイプを対象とする。
' |・VBSにてペイントを起動する。
' |・Excel側で切り取りした画像をペイントに貼り付ける。
' |・ペイントで色反転後切り取りした画像をExcelに貼り付
' | ける。
'------------------------------------------------------------
' 引数 |無し
' 戻り値 |無し
' 作成 |2015.10.02
' 作成者 |ナナミ
' Ver |1.00
'------------------------------------------------------------
Sub AllReversePictureColor()

Dim RC As Integer 'メッセージボックスイベント格納用
Dim StartSheet As String 'マクロ処理開始時のシート名格納用
Dim ws As Worksheet 'ワークシート格納用
Dim Shp As Shape '図形オブジェクト格納用
Dim ShpWidth As Single '図形幅格納用
Dim ShpHeight As Single '図形高さ格納用
Dim ShpLeft As Single '図形横位置格納用
Dim ShpTop As Single '図形縦位置格納用
Dim VBSRC As Integer 'VBS実行結果格納用

Const ProcessName = "mspaint.exe" 'ペイントのプロセス名称

'************************************************************
' ペイント起動中チェック
'************************************************************
''■ペイント起動中の場合は処理終了
If TaskExists(ProcessName) = True Then
MsgBox "ペイント(" & ProcessName & ")が起動中です。" & vbCrLf & _
"ペイントを閉じた後、再度実行して下さい。", vbExclamation
Exit Sub
End If


'************************************************************
' VBSファイルの存在チェック
'************************************************************
''■VBSファイルが見つからない場合は処理終了
If Dir(ThisWorkbook.Path & "\" & VBS_NAME) = "" Then
MsgBox VBS_NAME & " " & "が見つかりませんでした。" & vbCrLf & _
"このファイルと同じディレクトリ内にあるか確認して下さい。", vbExclamation
Exit Sub
End If


'************************************************************
' 処理開始確認
'************************************************************
''■確認ダイアログ表示
RC = MsgBox("画像を全て色反転します。" & vbCrLf & "よろしいですか?", _
vbYesNo + vbExclamation + vbDefaultButton2)
If RC = vbNo Then
Exit Sub
End If


'************************************************************
' 画像色反転開始
'************************************************************
''■マクロ処理開始時のシート名を取得
''■(処理完了後にこのシートに戻る)
StartSheet = ActiveSheet.Name

''■全シートに対して処理を行う
For Each ws In ActiveWorkbook.Worksheets
ws.Activate 'シートをアクティブにする

''■図形毎の処理
For Each Shp In ws.Shapes

''■画像のみ処理を行う
If Shp.Type = msoPicture Then

''■画像情報取得&切り取り
With Shp
ShpWidth = .Width '幅取得
ShpHeight = .Height '高さ取得
ShpLeft = .Left '横位置取得
ShpTop = .Top '縦位置取得
.ScaleWidth 1!, msoTrue, msoScaleFromTopLeft '幅倍率を100%に戻す
.ScaleHeight 1!, msoTrue, msoScaleFromTopLeft '高さ倍率を100%に戻す
.Cut '画像を切り取り
End With

''■VBSを実行
VBSRC = VBSRun()
If VBSRC = 0 Then GoTo ObjFree 'VBSがエラーの場合は処理終了

''■画像貼り付け&位置調整
ws.Activate 'シートをアクティブにする
ws.Paste '画像を貼り付け
With Selection
.Left = ShpLeft '横位置調整
.Top = ShpTop '縦位置調整
.Width = ShpWidth '幅調整
.Height = ShpHeight '高さ調整
End With
ws.Cells(1, 1).Select
End If
Next Shp
Next ws


'************************************************************
' 使用した各種オブジェクトの解放(ペイントの終了も行う)
'************************************************************
ObjFree:
Call ProcessTerminate(ProcessName) 'ペイントの終了
Set Shp = Nothing
Set ws = Nothing
Worksheets(StartSheet).Activate 'マクロ処理開始時のシートに戻る

MsgBox "画像の色反転が完了しました。"

End Sub


'------------------------------------------------------------
' 処理名 |アクティブシートの全画像を色反転する処理
'------------------------------------------------------------
' 概要 |・アクティブシート上の全画像オートシェイプを対象とする。
' |・VBSにてペイントを起動する。
' |・Excel側で切り取りした画像をペイントに貼り付ける。
' |・ペイントで色反転後切り取りした画像をExcelに貼り付
' | ける。
'------------------------------------------------------------
' 引数 |無し
' 戻り値 |無し
' 作成 |2015.10.02
' 作成者 |ナナミ
' Ver |1.00
'------------------------------------------------------------
Sub ReversePictureColor()

Dim RC As Integer 'メッセージボックスイベント格納用
Dim Shp As Shape '図形オブジェクト格納用
Dim ShpWidth As Single '図形幅格納用
Dim ShpHeight As Single '図形高さ格納用
Dim ShpLeft As Single '図形横位置格納用
Dim ShpTop As Single '図形縦位置格納用
Dim VBSRC As Integer 'VBS実行結果格納用

Const ProcessName = "mspaint.exe" 'ペイントのプロセス名称

'************************************************************
' ペイント起動中チェック
'************************************************************
''■ペイント起動中の場合は処理終了
If TaskExists(ProcessName) = True Then
MsgBox "ペイント(" & ProcessName & ")が起動中です。" & vbCrLf & _
"ペイントを閉じた後、再度実行して下さい。", vbExclamation
Exit Sub
End If


'************************************************************
' VBSファイルの存在チェック
'************************************************************
''■VBSファイルが見つからない場合は処理終了
If Dir(ThisWorkbook.Path & "\" & VBS_NAME) = "" Then
MsgBox VBS_NAME & " " & "が見つかりませんでした。" & vbCrLf & _
"このファイルと同じディレクトリ内にあるか確認して下さい。", vbExclamation
Exit Sub
End If


'************************************************************
' 処理開始確認
'************************************************************
''■確認ダイアログ表示
RC = MsgBox("「" & ActiveSheet.Name & "」シートの画像を全て色反転します。" & vbCrLf & _
"よろしいですか?", vbYesNo + vbExclamation + vbDefaultButton2)
If RC = vbNo Then
Exit Sub
End If


'************************************************************
' 画像色反転開始
'************************************************************
''■図形毎の処理
For Each Shp In ActiveSheet.Shapes

''■画像のみ処理を行う
If Shp.Type = msoPicture Then

''■画像情報取得&切り取り
With Shp
ShpWidth = .Width '幅取得
ShpHeight = .Height '高さ取得
ShpLeft = .Left '横位置取得
ShpTop = .Top '縦位置取得
.ScaleWidth 1!, msoTrue, msoScaleFromTopLeft '幅倍率を100%に戻す
.ScaleHeight 1!, msoTrue, msoScaleFromTopLeft '高さ倍率を100%に戻す
.Cut '画像を切り取り
End With

''■VBSを実行
VBSRC = VBSRun()
If VBSRC = 0 Then GoTo ObjFree 'VBSがエラーの場合は処理終了

''■画像貼り付け&位置調整
ActiveSheet.Paste '画像を貼り付け
With Selection
.Left = ShpLeft '横位置調整
.Top = ShpTop '縦位置調整
.Width = ShpWidth '幅調整
.Height = ShpHeight '高さ調整
End With
ActiveSheet.Cells(1, 1).Select
End If
Next Shp


'************************************************************
' 使用した各種オブジェクトの解放(ペイントの終了も行う)
'************************************************************
ObjFree:
Call ProcessTerminate(ProcessName) 'ペイントの終了
Set Shp = Nothing

MsgBox "「" & ActiveSheet.Name & "」シートの画像の色反転が完了しました。"

End Sub


'------------------------------------------------------------
' 処理名 |VBSを実行する処理
'------------------------------------------------------------
' 概要 |・VBSを実行する。
' |・VBS戻り値がエラーの場合は処理を終了する。
' |・VBSの引数は無しとする。
'------------------------------------------------------------
' 引数 |無し
' 戻り値 |リターンコード
' |失敗:0、成功:-1
' 作成 |2015.10.02
' 作成者 |ナナミ
' Ver |1.00
'------------------------------------------------------------
Function VBSRun() As Integer

Dim WSHObj 'Shellオブジェクト
Dim VBSsend As String 'VBSに渡す引数
Dim intRunRet As Integer 'VBS戻り値

'************************************************************
' VBS実行準備
'************************************************************
intRunRet = 0 'VBS戻り値の初期値を設定

''■オブジェクト作成
Set WSHObj = CreateObject("WScript.Shell") 'Shellオブジェクト作成

''■VBSに渡す引数を作成
VBSsend = """" & ThisWorkbook.Path & "\" & VBS_NAME & """" 'VBS名(フルパス)


'************************************************************
' VBS実行
'************************************************************
''■VBS実行
intRunRet = WSHObj.Run(VBSsend, 0, True)
' MsgBox "intRunRet =" & intRunRet 'デバッグ用メッセージ

''■VBS戻り値がエラー値の場合は処理終了
If intRunRet = 0 Then
MsgBox "「" & VBS_NAME & "」の処理でエラーが発生しました。" & vbCrLf & _
"マクロ処理を終了します。", vbCritical
GoTo ObjFree 'オブジェクトの解放まで移動
End If


'************************************************************
' 使用した各種オブジェクトの解放
'************************************************************
ObjFree:
VBSRun = intRunRet 'VBSファイルの戻り値を関数の戻り値として格納
Set WSHObj = Nothing

End Function


'------------------------------------------------------------
' 処理名 |対象プロセスを終了させる処理
'------------------------------------------------------------
' 概要 |・対象プロセス名を検索し、実行中の場合終了する。
'------------------------------------------------------------
' 引数 |検索プロセス名
' 戻り値 |無し
' 作成 |2015.10.02
' 作成者 |ナナミ
' Ver |1.00
'------------------------------------------------------------
Sub ProcessTerminate(ProcessName As String)

Dim Locator 'WMIオブジェクト
Dim Server 'コネクトサーバ格納用オブジェクト
Dim objSet 'プロセス取得用
Dim obj '各々のプロセスに対する処理用

'************************************************************
' オブジェクト作成
'************************************************************
Set Locator = CreateObject("WbemScripting.SWbemLocator") 'WMIオブジェクト作成
Set Server = Locator.ConnectServer '自PCに接続
Set objSet = Server.ExecQuery("Select * From Win32_Process") '実行中プロセスを取得


'************************************************************
' 対象プロセスを終了させる
'************************************************************
For Each obj In objSet
''■対象プロセスが実行中の場合、プロセスを強制終了し処理を抜ける
If obj.Caption = ProcessName Then
obj.Terminate
Exit For
End If
Next


'************************************************************
' 使用した各種オブジェクトの解放
'************************************************************
Set obj = Nothing
Set objSet = Nothing
Set Server = Nothing
Set Locator = Nothing

End Sub

d_画像削除

 おまけ処理です。このモジュールには以下2つを記述しています。

Excelファイルの全画像を削除する処理
アクティブシートの全画像を削除する処理

 ものすごく簡単です。VBSも使用しません。シート中に画像オートシェイプがあれば削除する、ということをしているだけです。 
ソース
Option Explicit

'------------------------------------------------------------
' 処理名 |Excelファイルの全画像を削除する処理
'------------------------------------------------------------
' 概要 |・Excelファイル上の全画像オートシェイプを対象とする。
' |・シート毎に画像を判別し削除する。
'------------------------------------------------------------
' 引数 |無し
' 戻り値 |無し
' 作成 |2015.10.05
' 作成者 |ナナミ
' Ver |1.00
'------------------------------------------------------------
Sub AllPictureDelete()

Dim RC As Integer 'メッセージボックスイベント格納用
Dim ws As Worksheet 'ワークシート格納用
Dim Shp As Shape '図形オブジェクト格納用

'************************************************************
' 処理開始確認
'************************************************************
''■確認ダイアログ表示
RC = MsgBox("画像を全て削除します。" & vbCrLf & "よろしいですか?", _
vbYesNo + vbExclamation + vbDefaultButton2)
If RC = vbNo Then
Exit Sub
End If


'************************************************************
' 画像削除開始
'************************************************************
''■全シートに対して処理を行う
For Each ws In ActiveWorkbook.Worksheets

''■図形毎の処理
For Each Shp In ws.Shapes

''■画像のみ処理を行う
If Shp.Type = msoPicture Then
Shp.Delete '画像削除
End If
Next Shp
Next ws


'************************************************************
' 使用した各種オブジェクトの解放
'************************************************************
Set Shp = Nothing
Set ws = Nothing

MsgBox "全画像削除完了しました。"

End Sub


'------------------------------------------------------------
' 処理名 |アクティブシートの全画像を削除する処理
'------------------------------------------------------------
' 概要 |・アクティブシート上の全画像オートシェイプを対象とする。
' |・シート内の画像を判別し削除する。
'------------------------------------------------------------
' 引数 |無し
' 戻り値 |無し
' 作成 |2015.10.05
' 作成者 |ナナミ
' Ver |1.00
'------------------------------------------------------------
Sub PictureDelete()

Dim RC As Integer 'メッセージボックスイベント格納用
Dim Shp As Shape '図形オブジェクト格納用

'************************************************************
' 処理開始確認
'************************************************************
''■確認ダイアログ表示
RC = MsgBox("「" & ActiveSheet.Name & "」シートの画像を全て削除します。" & vbCrLf & _
"よろしいですか?", vbYesNo + vbExclamation + vbDefaultButton2)
If RC = vbNo Then
Exit Sub
End If


'************************************************************
' 画像削除開始
'************************************************************
''■図形毎の処理
For Each Shp In ActiveSheet.Shapes

''■画像のみ処理を行う
If Shp.Type = msoPicture Then
Shp.Delete '画像削除
End If
Next Shp


'************************************************************
' 使用した各種オブジェクトの解放
'************************************************************
Set Shp = Nothing

MsgBox "「" & ActiveSheet.Name & "」シートの全画像削除完了しました。"

End Sub

ReversePictureColor(VBS)

 今回の処理の肝であるVBS処理です。ここでペイントを起動し、色反転を行っています。
 ここでもユーザー定義関数で使用したプロセス実行中判定処理を使用しています。
 ペイント起動後の操作は「SendKeys」で擬似キーボード操作を行っています。また、ペイントの起動と画像切り取りに時間が掛かる為、直後にSleep関数を入れて調整しています。ここが特にマシンスペックや画像の大きさに依存してきますので、上手くいかない場合はここのSleep関数を調整して下さい。
 補足ですが、このVBSは引数の数によって「SelectCase」で分岐する処理にしています。その為、今回は引数無しですが、引数を増やしたい場合、簡単に拡張できるような作りにしています。
ソース
'------------------------------------------------------------
' 処理名 |ペイントを起動後、コピーした画像ファイルを色反転し
'     |切り取りを行う処理
'------------------------------------------------------------
' 概要 |・ペイントを起動する。
' |・既に起動中の場合はアクティブにする。
' |・色反転した画像を「Ctrl+x」操作により切り取りを行う。
' |・VBS起動前に画像をクリップボードに格納しておくこと。
'------------------------------------------------------------
' 引数 |無し
' 戻り値 |リターンコード
' |失敗:0、成功:-1
' 作成 |2015.10.02
' 作成者 |ナナミ
' Ver |1.00
'------------------------------------------------------------
Option Explicit

Dim oParam ' 引数格納用
Dim objShell ' Shellオブジェクト
Dim ExcelApp ' Excelオブジェクト
Dim ret ' 戻り値

Const ProcessName = "mspaint.exe" ' 起動ツール名
Const vbMinimizedFocus = 2 ' 最小化かつ最前面のウィンドウ

'◆◆◆◆◆◆◆◆◆◆
' 処理開始
'◆◆◆◆◆◆◆◆◆◆
'************************************************************
' 処理前準備
'************************************************************
ret = 0 ' 戻り値の初期値
Set oParam = WScript.Arguments ' 引数格納


'************************************************************
' 引数の個数で条件分岐
'************************************************************
Select Case oParam.Count

'' ■0個の場合
Case 0
Set objShell = WScript.CreateObject("WScript.Shell")
Set ExcelApp = CreateObject("Excel.Application")
'' ■ペイントは起動中か?
If TaskExists() = False Then
objShell.Run ProcessName , vbMinimizedFocus , False ' ペイント起動
Wscript.Sleep 300 ' 0.3秒待機
Else
objShell.AppActivate ProcessName ' ペイントをアクティブにする
End If
objShell.SendKeys "^v" , True ' ペイントに画像貼り付け
objShell.SendKeys "^+i" , True ' 色反転
objShell.SendKeys "^x" , True ' 切り取り
Wscript.Sleep 500 ' 0.5秒待機
objShell.AppActivate ExcelApp.Caption ' Excelをアクティブにする
ret = -1 ' 戻り値-1をセット

'' ■それ以外の場合は戻り値0で終了
Case Else
ret = 0

End Select


'************************************************************
' 使用した各種オブジェクトの解放
'************************************************************
Set ExcelApp = Nothing
Set objShell = Nothing
Set oParam = Nothing
'WScript.Echo ret ' デバッグ用メッセージ
WScript.Quit(ret)

'◆◆◆◆◆◆◆◆◆◆
' 処理終了
'◆◆◆◆◆◆◆◆◆◆


'------------------------------------------------------------
' 処理名 |対象プロセスが実行中であるか判定する関数
'------------------------------------------------------------
' 概要 |・実行中プロセス内に同名プロセスが存在するか判定する。
' |・戻り値はBoolean型とする。
'------------------------------------------------------------
' 引数 |無し
' 戻り値 |実行中:True、実行中でない:False
' 作成 |2015.10.02
'------------------------------------------------------------
Function TaskExists()
Dim Locator : Set Locator = CreateObject("WbemScripting.SWbemLocator")
Dim Server : Set Server = Locator.ConnectServer
Dim objSet : Set objSet = Server.ExecQuery("Select * From Win32_Process")
Dim obj

'************************************************************
' 戻り値の初期値設定(False)
'************************************************************
TaskExists = False


'************************************************************
' 対象プロセスを検索
'************************************************************
For Each obj In objSet
'' ■対象プロセスは実行中か?
If obj.Caption = ProcessName Then
TaskExists = True
Exit For
End If
Next


'************************************************************
' 使用した各種オブジェクトの解放
'************************************************************
Set obj = Nothing
Set objSet = Nothing
Set Server = Nothing
Set Locator = Nothing

End Function
 以上です。最後に雑記を少し。。。
 ソースを見れば分かったと思いますが、基本的に私は省略した記述の仕方をしません。単純に分かりにくいからです。
 例えば変数定義の記述も人によっては1行や2行で済ます人もいますが、定義がいくつあるのか、その定義が何か等をパッと見で分かる記述の方が個人的には好きです。
 コメントも後で見返して処理内容が思い出せるようにしっかりと記述します。また、プログラムは他の人も参照することがあるという考えが前提にあるので、詳細に記述することを心掛けています。「処理名」「概要」「引数」「戻り値」等を処理の先頭にズラズラと記載しているのはその為です。
 色んな方のプログラムを見てきましたが、プログラムソースは本当に個性が出ます。最終的には自分に合った記述の仕方があると思いますので、私の記述が正しいという訳でもありません。私もまだまだ試行錯誤している最中です。
 拙いソースですが、少しでもお役に立つことができればと思います。ではでは~ヾ(^▽^)

コメント

コメントはまだありません
コメントを書き込むにはログインしてください。

いまブロマガで人気の記事