- ベストアンサー
画像読み込み失敗の判定
- みんなの回答 (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等で持っている訳ではなさそうでした。それ以上は分かりかねます。
その他の回答 (3)
- mitarashi
- ベストアンサー率59% (574/965)
破損画像?がそんなに沢山存在しているのでしょうか?一回撥ねればおしまいの気がしますが。 二度手間になるのと、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を入れてローカルウィンドウで眺めてみましたが、「画像」であって、文字情報で持っている訳ではなさそうですので、取得は出来ないと思います。
お礼
有難うございます。 p = LoadPicture(FileName)を使用した場合、戻り値をform,image,picuterBoxなどのプロパティにセットすることはできますが、shape(図)にすることはできるでしょうか? また、AddPictureや、.Pictures.Insertで表示されるエラー表示は「画像」とのことですが、私としては、表示のサイズを変更すると改行位置が変化するので、何かしら文字情報はあるのではないかと考えたのですが、見当はずれでしょうか。 お分かりでしたらお教えください。
- ap_2
- ベストアンサー率64% (70/109)
>エラーメッセージを回避して一発で処理できれば理想的 ・・・って話なら On Error Resume Next で、どーかな。 DisplayAlertsは確認ダイアログを出さないだけなので、エラーで処理中断しますよ。
お礼
有難うございます。 その方法はすでに試してみました。 DisplayAlerts = False にした上で、 On Error Resume Next picuter = ActiveSheet.Shapes.Addpicture(....) としても、破損画像に出会うと、エラーメッセージが出てしまいます。 他のエラー(たとえば、既に存在するフォルダと同名のフォルダ作成、ゼロ割など)では、 On Error Resume Next で、何も表示されずに次に進むようですが、 Addpicture()についてはダメなようです。
- denbee
- ベストアンサー率28% (192/671)
回答のポイントがズレテいるかもしれませんが…。 読み込みに失敗とは、filenameで指定した画像ファイルが存在しない場合を想定しているのでしょうか? でしたら、AddPictureを実行する前に、ファイルの存在チェックを行えばよいかと思いますが。
お礼
早速のご回答有難うございます。 説明不足でしたが、読み込み失敗の前提は、画像ファイルは存在するけれども破損していて、Addpicture自体はエラーなしで実行できる場合です。 実は、引数SaveWithDocumentをTrueにして実行するのが本来の目的なんですが、破損したファイルに対してこれを実行すると「このファイルのインポート中にエラーが発生しました」というメッセージボックスが出てしまう場合があり、それはApplication.DisplayAlertsをFalseにしても回避できません。そこで考えたのが、一旦SaveWithDocumentをFalseにして仮読み込みを行い、作成されたShapeが画像でなければ、つまり、質問に添付したものであれば、本読み込みを行わないという方法です。ところが仮読み込みの結果を判定する方法がわからず今回の質問をさせて頂いた次第です。 もし、全体的な方法論として、より適切なものがあればご教示ください。エラーメッセージを回避して一発で処理できれば理想的です。
お礼
お知恵を頂き、誠に有難うございます。 二度手間ながら、LoadPictureで画像が正常であることを確認をしたのちに、正常の場合のみAddPicureを行うコーディングをしてみましたが、今度はLoadPictureから制御が戻ってこない場合が発生し、難渋しています。壊れたファイルを扱うのは、なかなか一筋縄ではいかないものですね。 今のところ、唯一、AddPictureでSaveWithDocumentをFalseにした場合にエラーメッセージを出さずにすべての処理が終わるので、これを何とか利用して、SaveWithDocument=Trueでの実行の可否を判断できないものかと考えています。
補足
質問者です 話がややこしくなってしまいましたので、一旦閉めて、シンプルに再質問させて頂きます。 また、宜しくお願い致します。