No.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等で持っている訳ではなさそうでした。それ以上は分かりかねます。
お知恵を頂き、誠に有難うございます。
二度手間ながら、LoadPictureで画像が正常であることを確認をしたのちに、正常の場合のみAddPicureを行うコーディングをしてみましたが、今度はLoadPictureから制御が戻ってこない場合が発生し、難渋しています。壊れたファイルを扱うのは、なかなか一筋縄ではいかないものですね。
今のところ、唯一、AddPictureでSaveWithDocumentをFalseにした場合にエラーメッセージを出さずにすべての処理が終わるので、これを何とか利用して、SaveWithDocument=Trueでの実行の可否を判断できないものかと考えています。
No.3
- 回答日時:
破損画像?がそんなに沢山存在しているのでしょうか?一回撥ねればおしまいの気がしますが。
二度手間になるのと、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で表示されるエラー表示は「画像」とのことですが、私としては、表示のサイズを変更すると改行位置が変化するので、何かしら文字情報はあるのではないかと考えたのですが、見当はずれでしょうか。
お分かりでしたらお教えください。
No.2
- 回答日時:
>エラーメッセージを回避して一発で処理できれば理想的
・・・って話なら On Error Resume Next で、どーかな。
DisplayAlertsは確認ダイアログを出さないだけなので、エラーで処理中断しますよ。
有難うございます。
その方法はすでに試してみました。
DisplayAlerts = False
にした上で、
On Error Resume Next
picuter = ActiveSheet.Shapes.Addpicture(....)
としても、破損画像に出会うと、エラーメッセージが出てしまいます。
他のエラー(たとえば、既に存在するフォルダと同名のフォルダ作成、ゼロ割など)では、
On Error Resume Next
で、何も表示されずに次に進むようですが、
Addpicture()についてはダメなようです。
No.1
- 回答日時:
回答のポイントがズレテいるかもしれませんが…。
読み込みに失敗とは、filenameで指定した画像ファイルが存在しない場合を想定しているのでしょうか?
でしたら、AddPictureを実行する前に、ファイルの存在チェックを行えばよいかと思いますが。
早速のご回答有難うございます。
説明不足でしたが、読み込み失敗の前提は、画像ファイルは存在するけれども破損していて、Addpicture自体はエラーなしで実行できる場合です。
実は、引数SaveWithDocumentをTrueにして実行するのが本来の目的なんですが、破損したファイルに対してこれを実行すると「このファイルのインポート中にエラーが発生しました」というメッセージボックスが出てしまう場合があり、それはApplication.DisplayAlertsをFalseにしても回避できません。そこで考えたのが、一旦SaveWithDocumentをFalseにして仮読み込みを行い、作成されたShapeが画像でなければ、つまり、質問に添付したものであれば、本読み込みを行わないという方法です。ところが仮読み込みの結果を判定する方法がわからず今回の質問をさせて頂いた次第です。
もし、全体的な方法論として、より適切なものがあればご教示ください。エラーメッセージを回避して一発で処理できれば理想的です。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Excel(エクセル) 中身がFALSEなのにTRUEになる 2 2022/11/25 09:22
- PHP アップロード画像数でCSSを分けることに成功したのですが、画像の横に文字を並べることが出来ません。 3 2023/07/28 17:16
- Excel(エクセル) EXCELのグラフを画像(JPG形式)で保存、通常実行がうまく行かない。ステップインはうまく行く 3 2022/08/30 12:06
- Java java 次の機能を有するメソッドを自クラスに作成し、実装したいです。 機能 名前判定機能 →名前が 3 2022/06/16 16:08
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/06 13:01
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- XML エクセルのマクロについて教えてください。 3 2023/02/06 09:06
- Excel(エクセル) Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて 2 2022/11/15 16:14
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
gccを行ってもexeファイルが生...
-
access テキストボックスの値取得
-
Access2013にてドラッグ&ドロ...
-
VBでファイルが開かれているか...
-
Adobeのプレミアプロの書き出し...
-
freadでデータがない場合の読込...
-
VB:「実行時エラー53 実行ファ...
-
エクセルVBAでパワーポイントを...
-
Returnに対するGoSubがありません
-
ADOを使用してExcelファイルを...
-
Request.BinaryReadでのエラー
-
アクセスのクエリでコンパイル...
-
FORTRANの実行エラーについて
-
VBから参照できないCのDLLを使...
-
ディストリビューションで作成...
-
Access2010 コンパイルエラー...
-
Dreamweaver3で「onLoad内で_on...
-
batファイルでレジストリキーの...
-
VC++2005 windowsフォームアプ...
-
CSVファイルが開かれているかど...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
gccを行ってもexeファイルが生...
-
VBでファイルが開かれているか...
-
「パス名が無効です」の発生原因
-
batファイルでレジストリキーの...
-
Returnに対するGoSubがありません
-
VBから参照できないCのDLLを使...
-
PowerShellを使って関連付けら...
-
アクセスのクエリでコンパイル...
-
VB6 Dir関数で52エラー発生
-
FTPの送信結果を検知したい
-
NAS上のファイルの使用中が解除...
-
VBA ExecuteExcel4Macro 型が一...
-
access テキストボックスの値取得
-
EXCELのVBAでWORDが開いてある...
-
すでにファイルが開かれている...
-
EXCELVBAでONEDRIVE上への保管...
-
Excelファイルのマクロによる排...
-
OUTLOOK VBA 指定フォルダ内の...
-
RAR圧縮ファイル(分割)の順番が...
-
エクセルマクロでエラーの原因...
おすすめ情報