Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1452 / 13645 ツリー ←次へ | 前へ→

【74370】Runメソッドは失敗しました。 ゆらり 13/5/27(月) 14:49 質問[未読]
【74371】Re:Runメソッドは失敗しました。 kanabun 13/5/27(月) 17:13 発言[未読]
【74372】Re:Runメソッドは失敗しました。 ゆらり 13/5/27(月) 18:50 発言[未読]
【74374】Re:Runメソッドは失敗しました。 kanabun 13/5/27(月) 20:09 発言[未読]
【74375】Re:Runメソッドは失敗しました。 kanabun 13/5/27(月) 20:24 発言[未読]
【74376】Re:Runメソッドは失敗しました。 ゆらり 13/5/27(月) 20:59 発言[未読]
【74382】Re:Runメソッドは失敗しました。 kanabun 13/5/28(火) 11:11 発言[未読]
【74387】Re:Runメソッドは失敗しました。 kanabun 13/5/28(火) 19:38 発言[未読]

【74370】Runメソッドは失敗しました。
質問  ゆらり  - 13/5/27(月) 14:49 -

引用なし
パスワード
   書き込み失礼致します。

現在、エクセルVBAにて選択した画像を回転させ、保存するマクロを目標にしています。しかし、理解が足りずなかなか組めません。現在はファイルを開く時に掲題のエラーが出てしまいます。
宜しければどなたかご教授頂けないでしょうか?
簡単な説明を頂けると幸いです。宜しくお願い致します。

ソースは

Sub selectfile(myFnames, fileNo, errCode)
Dim myFnames as Variant
Dim errCode as Integer

  myFnames = Application.GetOpenFilename("ビットマップ ファイル (*.bmp),*.bmp", , "ファイルを選択してください", , True) '入力ファイル名の選択
If myFnames(1) = False Then errCode = 1

'選択したファイルの回転と保存
 Rotationfile myFnames(1)
  
  Sub Rotationfile(myFnames)
With CreateObject("Wscript.shell")
CreateObject("WScript.Shell").Run "myFnames(1)", 5, True
End With
End Sub

【74371】Re:Runメソッドは失敗しました。
発言  kanabun  - 13/5/27(月) 17:13 -

引用なし
パスワード
   ▼ゆらり さん:

>現在、エクセルVBAにて選択した画像を回転させ、保存するマクロを
> 目標にしています。しかし、理解が足りずなかなか組めません。

> ファイルを開く時に掲題のエラーが出てしまいます。

まず 「選択した画像をシートに図として挿入する」ということと
「ファイルを開く」ということは処理内容が違います。
Excelで 「ファイルを開く」といったら、ファイルの種類は *.xls か
*.csv かのファイルでしょう?
対して、
「選択した画像をシートに図として挿入する」
といったら、*.Bmpや *.jpg などの画像ファイルを Pictures.Insert
したり、Shapes.AddPicture したり、といったExcelの内部コマンド(?)
を使います。

どこにも WinScript.Shell のRun メソッドを使う動機付け(?)がありません。

それに、Run メソッドの使い方も変ですよ。
いちどネットで検索して 構文を理解してください。
WScript.ShellのRun は 外部プログラムを実行するときなどに使います。
たとえば、
メモ帳を起動してテキストファイルを開き、ユーザーがメモ帳を終了する
まで待機し、終了時にメモ帳から返されるエラーコードを受け取るなら
 Dim ok As Long
 Dim myTextFile As String

 myTextFile = "D:\(Data)\abc.Txt"
 With CreateObject("WScript.Shell")
   ok = .Run("Notepad.exe " & myTextFile, 1, True)
 End With

のように Run の後には 実行可能ファイル(外部プログラム)を指定し、
その外部プログラムのオプションとして テキストファイル名を指定します。

また、WScript.Shellの Runメソッドは DOSコマンドを実行するときにも
使います。以下は DOSウィンドウを開き、パスを C:\ に変更し、
DIR コマンドを実行する例です。

 With CreateObject ("WSCript.shell")
  .Run "cmd /K CD C:\ & Dir"
 End With


>選択した画像を回転させ、保存するマクロ

を作りたいなら、まずは、
「図の挿入」メニューから画像を挿入し、回転させる操作の
マクロ記録をとってみるとイイと思います。

【74372】Re:Runメソッドは失敗しました。
発言  ゆらり  - 13/5/27(月) 18:50 -

引用なし
パスワード
     ▼kanabun さん:

迅速な対応非常にありがとうございます。

私の説明が抜け過ぎていました。申し訳ありません。

今回「ファイルを開きたい」と申しますのは、その画像と関連付いている外部アプリを用いて開き、マクロからキーを送信し、保存したい所存です。

非常に乱雑なソースを貼り付けてしまったので余計に混乱を招きました。
ご回答頂いたのにもかかわらず、申し訳ありません。

引き続きご教授お願い致します。


【74374】Re:Runメソッドは失敗しました。
発言  kanabun  - 13/5/27(月) 20:09 -

引用なし
パスワード
   ▼ゆらり さん:

>今回「ファイルを開きたい」と申しますのは、その画像と関連付いている
>外部アプリを用いて開き、マクロからキーを送信し、保存したい所存です。

外部プログラムの名前もわからないし、仮に分ったところで、
「外部プログラムで 画像を開く」だけじゃなく、開いて Rotate させて
それを上書き保存するまで 外からやらせるとなると、並大抵の知恵では
出来ないと思います。

そうまでしてExcelマクロから 操作する必要性はあるのですか?

【74375】Re:Runメソッドは失敗しました。
発言  kanabun  - 13/5/27(月) 20:24 -

引用なし
パスワード
   たとえばぼくのもっている 画像閲覧ソフト SuperJPG は
フォルダごとに表示されるサブネイルから 複数画像を選択して
[Rotate]メニューのサブメニューから

 Clockwize
 CCW
 Rotate 180
 Flip Vertical
 Flip Horizontal

のどれかを選べば、複数画像を一括Rotateしてくれます。
そういうことがしたいなら、そういうことのできる外部ソフトを
使えば簡単なことだと思うのですが。

【74376】Re:Runメソッドは失敗しました。
発言  ゆらり  - 13/5/27(月) 20:59 -

引用なし
パスワード
   ■kanabunさん

ご返答ありがとうございます。

画像ファイルを開いた後に、表示ファイルがアクティブの状態でSendkeyステートメントを使用して回転させるつもりでしたが、不可能ですか?

理解に苦しむ点はあるとは思いますが、今回は選択したファイルの回転を自動化することに意味があります。

ソフトはWindows Picture and Fax Viewerです。

【74382】Re:Runメソッドは失敗しました。
発言  kanabun  - 13/5/28(火) 11:11 -

引用なし
パスワード
   ▼ゆらり さん:

>画像ファイルを開いた後に、表示ファイルがアクティブの状態でSendkeyステートメントを使用して回転させるつもりでしたが、不可能ですか?

そういう手段は安定性がないのであまり考えない方がよいと思います。

外部ソフトに複数ファイルを一括Rotateするバッチ機能があれば、
ExcelVBAでマクロを組む必要はない。---これは前回のアドバイスですが、
もしそういう機能が無いのなら、
このスレッドの最初のぼくの(要件をかんちがいした)処理方法に戻って
こちらの方法を考えてもいいんじゃないかと思います。

というのも、
Excelで画像をシートに貼り付けて回転まではできるのですから、
あとはこれを元の画像形式で保存すればいいだけですので。。。

幸い shira さんが2005年にmougに投稿された(これ以前にもあったかも
知れませんが、ぼくが教えてもらったのはこのときでした)GDI の機能を使う
図の保存コードがあるので、それを使わせていただくことにすれば
話は簡単になります。

以下を新規モジュールに貼り付け、下のほうの
> Sub 画像ファイル回転保存90()
を実行してみてください。
このプロシージャは 画像を90°回転させ、元のファイル名に#90を
追加して保存し直すものです。

'--------
Option Explicit
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type
Private Type GdiplusStartupInput
  GdiplusVersion      As Long
  DebugEventCallback    As Long
  SuppressBackgroundThread As Long
  SuppressExternalCodecs  As Long
End Type
Private Declare Function GdiplusStartup Lib "gdiplus" _
    (token As Long, pInput As GdiplusStartupInput, _
    pOutput As Any) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" _
    (ByVal token As Long)
Private Declare Function GdipDisposeImage Lib "gdiplus" _
    (ByVal Image As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _
    (ByVal hbm As Long, ByVal hPal As Long, _
    bitmap As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "gdiplus" _
    (ByVal Image As Long, filename As Any, _
    clsidEncoder As GUID, encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" _
    (lpsz As Any, pClsid As GUID) As Long
Const CLSID_PNG_CODEC = "{557CF406-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_JPG_CODEC = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_BMP_CODEC = "{557cf400-1a04-11d3-9a73-0000f81ef32e}"
Const CLSID_GIF_CODEC = "{557cf402-1a04-11d3-9a73-0000f81ef32e}"

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_BITMAP = 2

Private Declare Function CopyImage Lib "user32" _
    (ByVal hImage As Long, ByVal uType As Long, _
    ByVal cxDesired As Long, ByVal cyDesired As Long, _
    ByVal fuFlags As Long) As Long
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4
Private Declare Function DeleteObject Lib "gdi32" _
   (ByVal hObject As Long) As Long

'--------------------------------------------------------------------------------

'// クリップボードにコピーされたBMP を 元の形式で保存
Function SaveBmpClipAs(ByVal savePath As String, _
    Style As String) As Boolean

  Dim udtInput As GdiplusStartupInput
  Dim EncoderId As GUID
  Dim lngToken As Long
  Dim pBitmap  As Long
  Dim hbmp   As Long
  Dim ClsID   As String

  If OpenClipboard(0) Then
    hbmp = CopyImage(GetClipboardData(CF_BITMAP), _
             IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    CloseClipboard
  End If
  If hbmp = 0 Then MsgBox "Failed to get hBmp": Exit Function

  udtInput.GdiplusVersion = 1
  If GdiplusStartup(lngToken, udtInput, ByVal 0&) = 0 Then
    If GdipCreateBitmapFromHBITMAP(hbmp, 0, pBitmap) = 0 Then
      Select Case LCase$(Style)
       Case "jpg", "jpeg"
         ClsID = CLSID_JPG_CODEC
       Case "png"
         ClsID = CLSID_PNG_CODEC
       Case "bmp"
         ClsID = CLSID_BMP_CODEC
      End Select
       CLSIDFromString ByVal StrPtr(ClsID), EncoderId
      If GdipSaveImageToFile( _
              pBitmap, ByVal StrPtr(savePath & ""), _
              EncoderId, ByVal 0&) = 0 Then
        SaveBmpClipAs = True
      End If
      GdipDisposeImage pBitmap
    End If
    GdiplusShutdown lngToken
  End If
  DeleteObject hbmp

End Function


'--------
Sub 画像ファイル回転保存90()
  Dim myPicFiles
  Dim saveFormat As String
  Dim m As Long
  
  '回転する画像ファイルの指定(複数可)
  myPicFiles = Application.GetOpenFilename( _
     "BMP or JPGファイル,*.Bmp;*.jpg;*.jpeg;*.Png", _
     MultiSelect:=True)
  If VarType(myPicFiles) = vbBoolean Then Exit Sub
  
  Dim picName
  Range("A1").Select
  Application.ScreenUpdating = False
  For Each picName In myPicFiles
    With ActiveSheet.Pictures.Insert(picName)
      .ShapeRange.IncrementRotation 90#
      .CopyPicture Format:=xlBitmap
      m = InStrRev(picName, ".")
      saveFormat = Mid$(picName, m + 1)
      SaveBmpClipAs Replace(picName, ".", "#90."), _
               Style:=saveFormat
      .Delete
    End With
  Next
  Application.ScreenUpdating = True

End Sub

【74387】Re:Runメソッドは失敗しました。
発言  kanabun  - 13/5/28(火) 19:38 -

引用なし
パスワード
   訂正

> GDI の機能を使う

 ↓

GDI+ の機能を使う

1452 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free