作業を効率化させるExcel VBA Tips集

上記の広告は１ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

以前、紹介した下記の記事。

・作業を効率化させるExcel VBA Tips集 選択した図形をJPEG画像として保存する

そもそも、何がしたかったか？というと、
ブログに掲載したい画像をExcel上で作成し、それを画像ファイルとして保存、
保存した画像ファイルをブログへアップロードすることを効率化させたいと思っていました。
その流れが下記の手順となります。

[Excelオートシェイプをブログへアップロードする手順]
１．Excelで図形を作成する
　↓
２．Excelで図形をコピー
　↓
３．グラフィックソフトを開く
　↓
４．コピーした図形を貼り付ける
　↓
５．JPEG指定で保存する
　↓
６．ブログの管理画面を開く
　↓
７．JPGファイルをブログへアップロード


そこで効率化させるポイントとして、
Excel上で作成したオートシェイプの図形をJPG画像ファイルとして自動保存させるという点でした。（上記赤字部分参照）

今回はアップロード自体も自動化させようという企みです。（上記青字部分参照）

で、前回紹介したコマンドプロンプトの起動が役に立ちます。

で、なんでコマンドプロンプトが必要なのか？というところなんですけど・・・

理想はVBA上でアップロードもすべてやりきれたら良いのですが、僕がやってる効率化のプログラミングで、インターネットにかかわる部分はJava言語で行ってます。
で、Javaで作ったアプリを実行させるにはコマンドプロンプトにてコマンド実行させてやる必要があるということです。

以下が僕が掲載しているもう一つのブログです。
・もしかしたら使えるかも？Java Tips集 XML-RPCを使ってJavaアプリからブログへファイルをアップロードする

上記リンクのページに記載しているJavaアプリをコマンドで実行してやると指定ファイルをブログへアップロードしてくれるというソースについて記載しています。
このJavaアプリは以下からダウンロードできます。が、JavaなのでもちろんJREがインストールされていることが前提です。

【ダウンロード】
任意の場所にダウンロードして解凍してください。classファイルとJarファイルが展開されます。
解凍先パスは後述のサンプルで設定するので覚えておいてください。
・ファイルアップロードJavaアプリ.lzh

【Javaアプリ制限事項】
・現状、上記のアプリでは日本語ファイル名のアップロードが行えません。原因究明中です。

下記掲載のVBAからコマンドによりJavaアプリへパラメータを渡してコールすることになるのですが、コメント文中にある「ユーザ設定箇所」に初期値を設定してやる必要があります。
設定する項目は以下のものです。

---

【”ユーザ設定箇所”記載事項】
・sClassPath：上記リンクより保存したモジュールのパスを設定してください。（最後スラッシュで終わること)

・sSavePath：JPGファイルを保存する場所を設定してください。（最後スラッシュで終わること)

・sXmlRpcUrl：各業者が提供しているブログサービスのXML-RPCのURLを記載ください。
　サンプルに記載しているURLはFC2ブログのものです。それ以外では、
　[Seesaa]：http://blog.seesaa.jp/rpc
　[ココログ]：http://app.cocolog-nifty.com/t/api
　[ブログ人]：http://app.blog.ocn.ne.jp/t/api/
　[Movable Type]：http://（それぞれのURL)/mt/xml-rpc.cgi

・sLoginUser：ブログ管理画面にログインするときのログインユーザ名を記載ください。

・sLoginPass：ブログ管理画面にログインするときのログインパスワードを記載ください。

・sBase64Flg：これもそれぞれの業者で違うかもしれませんが、FC2ブログの場合は0固定値でかまいません。MovableTypeは1固定値に設定してください。それ以外の業者についてはよくわかりません。0か1かで試してみてください。アップロードする画像ファイルに対してBase64エンコードするかどうかのフラグです。

以上、たくさん設定する内容がありますが、Javaアプリを汎用的にするためにパラメータが多くなってしましました。まぁ、でもユーザ設定箇所を入力しさえすれば、コマンド自体はVBAで文字列を作成します。なお、保存するJPGファイル名はVBA実行時に問い合わせダイアログが表示されます。

【サンプル実行方法】
長々と説明しましたが、以下がサンプルになります。
起動はExcel上の図形を選択して、JpgUploader_Main()関数を実行してください。

'--------------------------------------------------------------------
' 定義セクション
'--------------------------------------------------------------------
Private Type FLTIMAGE
    StructSize As Integer
    Type As Byte
    Reserved1(0 To 8) As Byte
    hImage As Long
    Reserved3(0 To 19) As Byte
End Type
Private Type FLTFILE
    Reserved1 As Integer
    Ext As String * 4
    Reserved2 As Integer
    Path As String * 260
    Reserved3 As Currency
End Type
Private Declare Function GetFilterInfo Lib _
  "C:\Program Files\Common Files\Microsoft Shared\Grphflt\JPEGIM32.FLT" _
       (ByVal Ver As Integer, ByVal Reserved As Long, _
        phMem As Long, ByVal flags As Long) As Long
Private Declare Function ExportGr Lib "JPEGIM32.FLT" _
   (ff As FLTFILE, fi As FLTIMAGE, ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" _
        (ByVal hWndNewOwner As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" _
        (ByVal uFormat As Long) As Long
Const CF_ENHMETAFILE = 14
Private Declare Function CopyEnhMetaFile Lib "gdi32" _
       Alias "CopyEnhMetaFileA" _
        (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
       (ByVal hemf As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" _
       (ByVal hMem As Long) As Long
'--------------------------------------------------------------------
' 関数名 : SaveClipToJpg
' 機能   : 指定図形をJPGファイルとして保存する
' 引数   : img : シェイプオブジェクト[I]
'          path ：格納先パス（ファイル名も含む）
' 戻り値 : 成否
' 作成日 : 2008/03/08
' 作成者 : lily(http://vbatips.blog37.fc2.com/)
'--------------------------------------------------------------
Function SaveClipToJpg(img As Shape, Path As String) As Boolean
Dim tFltImg As FLTIMAGE
Dim tFltFile As FLTFILE
Dim hemf As Long
Dim hMem As Long
  
    SaveClipToJpg = False
    
    'クリップボードにコピー
    img.CopyPicture
    'Selection.CopyPicture
    If OpenClipboard(0) Then
        hemf = CopyEnhMetaFile( _
                GetClipboardData(CF_ENHMETAFILE), _
                vbNullString)
        CloseClipboard
    End If
    If hemf = 0 Then Exit Function
    
    ' パラメータ設定
    tFltFile.Path = Path & vbNullChar
    With tFltImg
        .StructSize = LenB(tFltImg)
        .Type = 1
        .hImage = hemf
    End With
    ' フィルタ呼び出し
    If GetFilterInfo(3, 0, hMem, &H10000) And &H10 Then
        If ExportGr(tFltFile, tFltImg, hMem) = 0 Then
            SaveClipToJpg = True
        End If
    End If
    
    If hMem Then GlobalFree hMem
    DeleteEnhMetaFile hemf

End Function
'--------------------------------------------------------------------
' 関数名 : CheckZenkaku
' 機能   : 対象文字列に全角文字が含まれているかどうかチェックします
' 引数   : str ：対象文字列[I]
' 戻り値 : True ：全角文字混在　False：全て半角文字
' 作成日 : 2008/03/09
' 作成者 : lily(http://vbatips.blog37.fc2.com/)
'---------------------------------------------------------------------
Function CheckZenkaku(ByVal str As String) As Boolean
Dim strAnsi As String

    strAnsi = StrConv(str, vbFromUnicode)
    
    If Len(str) = LenB(strAnsi) Then
        CheckZenkaku = False
    Else
        CheckZenkaku = True
    End If

End Function

'--------------------------------------------------------------------
' 関数名 : JpgUploader_Main
' 機能   : VBAのオートシェイプを保存しブログへ画像をアップロードする
' 引数   : なし
' 戻り値 : なし
' 作成日 : 2008/03/09
' 作成者 : lily(http://vbatips.blog37.fc2.com/)
'--------------------------------------------------------------------
Sub JpgUploader_Main()

Dim bSaveFlg As Boolean
Dim sShapeName As String
Dim sFileName As String
Dim sSavePath As String
Dim sXmlRpcUrl As String
Dim sLoginUser As String
Dim sLoginPass As String
Dim sBase64Flg  As String
Dim sClassPath As String
Dim sCmdStr As String
    
    '****************************************************************************************
    '* ユーザ設定箇所　Start
    
        sClassPath = "E:/test/mdl/"                     'mdlフォルダ格納パス（最後スラッシュで終わること)
        sSavePath = "E:/test/Jpg/"                      'JPG保存先パス（最後スラッシュで終わること)
        sXmlRpcUrl = "http://blog.fc2.com/xmlrpc.php"   'FC2ブログXml-RpcのURL
                                                        '※ブログサービス毎に異なる
        sLoginUser = "××××××"                     'ブログにログインする為のユーザ名
        sLoginPass = "××××"                         'ブログにログインする為のパスワード
        
        '画像のアップロードを行う際、画像のバイナリデータをBase64にエンコードするという仕様が
        'ありますが、FC2ブログの場合はエンコードしなくても良いので0を設定します。他のブログサービスで
        'エンコードが必要かどうかは？試してません。ただ、Movable Typeに関してはエンコードの必要が
        'あります。
        '　エンコード有り：1  例）Movable Type
        '　エンコード無し:0   例）FC2ブログ
        sBase64Flg = "0"
        
    '* ユーザ設定箇所　End
    '****************************************************************************************
    
    'オートシェイプの名前取得
    sShapeName = Selection.Name
    
    Do
        'ファイル名入力画面表示
        sFileName = InputBox("ファイル名を入力してください。（拡張子無し）")
        
        If CheckZenkaku(sFileName) = True Then
            MsgBox "ファイル名は半角文字のみで入力してください"
        Else
            Exit Do
        End If
    Loop
    
    If sFileName = "" Then
        sFileName = sShapeName & ".jpg"
        sFileName = Replace(sFileName, " ", "")
    Else
        sFileName = sFileName & ".jpg"
    End If

    sSavePath = sSavePath & sFileName

    'オートシェイプ保存
    bSaveFlg = SaveClipToJpg(ActiveSheet.shapes(sShapeName), sSavePath)
    If bSaveFlg = True Then
        'MsgBox "保存に成功しました"
    Else
        MsgBox "保存に失敗しました"
        Exit Sub
    End If

    'コマンド作成
    sCmdStr = "cmd.exe /k java -cp "
    sCmdStr = sCmdStr & sClassPath & ".;"
    sCmdStr = sCmdStr & sClassPath & "commons-codec-1.3.jar;"
    sCmdStr = sCmdStr & sClassPath & "xmlrpc-2.0.jar;"
    sCmdStr = sCmdStr & " " & "BlogFileUpLoader"
    sCmdStr = sCmdStr & " " & sSavePath
    sCmdStr = sCmdStr & " " & sXmlRpcUrl
    sCmdStr = sCmdStr & " " & sLoginUser
    sCmdStr = sCmdStr & " " & sLoginPass
    sCmdStr = sCmdStr & " " & sBase64Flg

    Debug.Print sCmdStr

    'アップロード実行
    Call Shell(sCmdStr, vbNormalFocus)

End Sub

これで、Excel上で作成したオートシェイプはボタン一つで、ブログへアップロードできるという画期的な仕組みが実現できたワケです。でも、これ作成するまで、結構時間かかりました・・・。
そして、このVBAを使う側もJREが必要だとか、初期値を設定しなきゃいけないとか、いらない作業が多いので、ブログのヘビーユーザーじゃなければ、効率化できないかもしれませんね。