プロが教える店舗&オフィスのセキュリティ対策術

VBA Excel2007を使用しています。

画像をインポートするために、例えば、myPicuter = ActiveSheet.Shapes.AddPicture(filename, true, false, 0, 0, 100,100)を実行した際に、読み込みに失敗するとmyPictureとして添付のような表示が現れますが、このmyPicuterが画像でないことを判定する方法は有るでしょうか。
また、もし直接判定ができなければ、中の文字列を読み出して、その内容から判定する方法はあるでしょうか。

「画像読み込み失敗の判定」の質問画像

A 回答 (4件)

#3です。


最初のご質問は、当方のコレクションを組み合わせれば実現できますが、Clipboardを何度も経由して美しく無いです。Bitmap->StdPictureのコードはゴロゴロしていますが、その逆が分かりません。実は凄く簡単な事だったりして...

Public Const PICTYPE_BITMAP = 1
Public Const CF_BITMAP = 2
Public Const IMAGE_BITMAP = 0
Public Const LR_COPYRETURNORG = &H4

Public Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Sub test()
Dim p As Object
Dim fileName As String

fileName = "C:\Users\??????\Desktop\hoge.jpg"
On Error Resume Next
Set p = LoadPicture(fileName)
If Err.Number <> 0 Then
MsgBox Err.Description 'ピクチャが不正です。
Else
CopyBitmapPictureToCB p
'ClipboardのBitmapのPictureからはBMP形式でしか貼り付けられない
ActiveSheet.Paste
'ファイルの巨大化防止のため一旦CutしてJPEG貼り付け
ActiveSheet.Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
End If
On Error GoTo 0
End Sub

Private Function CopyBitmapPictureToCB(ByVal pic As Object) As Boolean
Dim hBmp As Long
If pic Is Nothing Then Exit Function
If pic.Type <> PICTYPE_BITMAP Then Exit Function
hBmp = pic.handle
hBmp = CopyImage(hBmp, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
If hBmp = 0 Then Exit Function
If OpenClipboard(0) Then
EmptyClipboard
If SetClipboardData(CF_BITMAP, hBmp) Then
hBmp = 0
CopyBitmapPictureToCB = True
End If
CloseClipboard
End If
If hBmp Then DeleteObject hBmp
End Function

後ろのご質問の方は当方が眺めた範囲では、TextFrame等で持っている訳ではなさそうでした。それ以上は分かりかねます。

この回答への補足

質問者です
話がややこしくなってしまいましたので、一旦閉めて、シンプルに再質問させて頂きます。
また、宜しくお願い致します。

補足日時:2014/01/30 09:51
    • good
    • 0
この回答へのお礼

お知恵を頂き、誠に有難うございます。

二度手間ながら、LoadPictureで画像が正常であることを確認をしたのちに、正常の場合のみAddPicureを行うコーディングをしてみましたが、今度はLoadPictureから制御が戻ってこない場合が発生し、難渋しています。壊れたファイルを扱うのは、なかなか一筋縄ではいかないものですね。

今のところ、唯一、AddPictureでSaveWithDocumentをFalseにした場合にエラーメッセージを出さずにすべての処理が終わるので、これを何とか利用して、SaveWithDocument=Trueでの実行の可否を判断できないものかと考えています。

お礼日時:2014/01/28 21:00

破損画像?がそんなに沢山存在しているのでしょうか?一回撥ねればおしまいの気がしますが。


二度手間になるのと、LoadPictureがサポートしている画像形式は限られていた記憶がありますが(JPEGは大丈夫)
LoadPictureならエラートラップ可能でした。

Dim p As Object
On Error Resume Next
Set p = LoadPicture(FileName)
If Err.Number <> 0 Then
MsgBox Err.Description 'ピクチャが不正です。
End If
On Error GoTo 0

イメージコントロールなら取得したPictureを使い回せるかもしれませんが、あまり良い思い出が無いのでお勧めしません。

なお、AddPictureや、.Pictures.Insertで表示されるエラー表示は、コード中にSTOPを入れてローカルウィンドウで眺めてみましたが、「画像」であって、文字情報で持っている訳ではなさそうですので、取得は出来ないと思います。
    • good
    • 0
この回答へのお礼

有難うございます。

p = LoadPicture(FileName)を使用した場合、戻り値をform,image,picuterBoxなどのプロパティにセットすることはできますが、shape(図)にすることはできるでしょうか?

また、AddPictureや、.Pictures.Insertで表示されるエラー表示は「画像」とのことですが、私としては、表示のサイズを変更すると改行位置が変化するので、何かしら文字情報はあるのではないかと考えたのですが、見当はずれでしょうか。

お分かりでしたらお教えください。

お礼日時:2014/01/27 21:20

>エラーメッセージを回避して一発で処理できれば理想的



・・・って話なら On Error Resume Next で、どーかな。
DisplayAlertsは確認ダイアログを出さないだけなので、エラーで処理中断しますよ。
    • good
    • 0
この回答へのお礼

有難うございます。
その方法はすでに試してみました。

DisplayAlerts = False

にした上で、

On Error Resume Next
picuter = ActiveSheet.Shapes.Addpicture(....)

としても、破損画像に出会うと、エラーメッセージが出てしまいます。
他のエラー(たとえば、既に存在するフォルダと同名のフォルダ作成、ゼロ割など)では、

On Error Resume Next

で、何も表示されずに次に進むようですが、

Addpicture()についてはダメなようです。

お礼日時:2014/01/25 21:04

回答のポイントがズレテいるかもしれませんが…。



読み込みに失敗とは、filenameで指定した画像ファイルが存在しない場合を想定しているのでしょうか?
でしたら、AddPictureを実行する前に、ファイルの存在チェックを行えばよいかと思いますが。
    • good
    • 0
この回答へのお礼

早速のご回答有難うございます。

説明不足でしたが、読み込み失敗の前提は、画像ファイルは存在するけれども破損していて、Addpicture自体はエラーなしで実行できる場合です。

実は、引数SaveWithDocumentをTrueにして実行するのが本来の目的なんですが、破損したファイルに対してこれを実行すると「このファイルのインポート中にエラーが発生しました」というメッセージボックスが出てしまう場合があり、それはApplication.DisplayAlertsをFalseにしても回避できません。そこで考えたのが、一旦SaveWithDocumentをFalseにして仮読み込みを行い、作成されたShapeが画像でなければ、つまり、質問に添付したものであれば、本読み込みを行わないという方法です。ところが仮読み込みの結果を判定する方法がわからず今回の質問をさせて頂いた次第です。

もし、全体的な方法論として、より適切なものがあればご教示ください。エラーメッセージを回避して一発で処理できれば理想的です。

お礼日時:2014/01/23 09:07

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!