
ほとんどが実行できますが時折エラーが出て中断されます。
エラー時の文章:実行時エラー 1004 rangeクラスのcopypictureメソッドが失敗しました。
エラーが起きる場所も毎回バラバラで、本来はタスクスケジューラで毎時自動で実行したいものなのでエラーが何とか起きないようにしたいです。
エラーが起きる場所は主に各範囲のpic.Chart.Pasteか、
各範囲それぞれのexportRange2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
この部分です。
助けてほしいですお願いします。
Private Sub Workbook_Open()
Dim FileSize As Long
Dim pic As ChartObject
Dim picName As String
Dim picName2 As String
Dim picName3 As String
Dim picName4 As String
Dim rng As Range
Dim exportRange2 As Range
Dim exportRange3 As Range
Dim exportRange4 As Range
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Dim path As String
Dim retryCounter As Integer
path = "C:\???\???\???\???\???\???\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each ws In Worksheets
Select Case ws.Name
Case "報告書"
picName = path & "image" & "1.png"
Set rng = ws.Range("D4:N52")
Application.Wait (Now + TimeValue("0:00:01"))
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set pic = ws.ChartObjects.Add(0, 0, rng.Width, rng.Height)
pic.Name = "ChartObject3"
pic.Chart.Export picName
FileSize = FileLen(picName)
If FileLen(picName) <= FileSize Then
pic.Chart.Paste
pic.Chart.Export picName
End If
pic.Delete
Set pic = Nothing
Case "グラフ"
'範囲1
picName2 = path & "image" & "2.png"
Set exportRange2 = ws.Range("A1:Y35")
Application.Wait (Now + TimeValue("0:00:01"))
exportRange2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set pic = ws.ChartObjects.Add(0, 0, exportRange2.Width, exportRange2.Height)
pic.Name = "ChartObject2"
pic.Chart.Export picName2
FileSize = FileLen(picName2)
If FileLen(picName2) <= FileSize Then
pic.Chart.Paste
pic.Chart.Export picName2
End If
pic.Delete
Set pic = Nothing
'範囲2
picName3 = path & "image" & "3.png"
Set exportRange3 = ws.Range("A36:Y70")
Application.Wait (Now + TimeValue("0:00:01"))
exportRange3.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set pic = ws.ChartObjects.Add(0, 0, exportRange3.Width, exportRange3.Height)
pic.Name = "ChartObject3"
pic.Chart.Export picName3
FileSize = FileLen(picName3)
If FileLen(picName3) <= FileSize Then
pic.Chart.Paste
pic.Chart.Export picName3
End If
pic.Delete
Set pic = Nothing
'範囲3
picName4 = path & "image" & "4.png"
Set exportRange4 = ws.Range("A71:Y105")
Application.Wait (Now + TimeValue("0:00:01"))
exportRange4.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set pic = ws.ChartObjects.Add(0, 0, exportRange4.Width, exportRange4.Height)
pic.Name = "ChartObject4"
pic.Chart.Export picName4
FileSize = FileLen(picName4)
If FileLen(picName4) <= FileSize Then
pic.Chart.Paste
pic.Chart.Export picName4
End If
pic.Delete
Set pic = Nothing
Case Else
GoTo NextSheet
End Select
NextSheet:
Next ws
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Quit
End Sub
A 回答 (3件)
- 最新から表示
- 回答順に表示
No.3
- 回答日時:
こんにちは
#2様ご指摘の部分だと思いますがApplication.Wait (Now + TimeValue("0:00:01")) をなくして
簡単なデモVBAで実行してみましたが1004エラーが出ず検証できませんでした
従ってエラールーチンで繰り返せば解消できるのか・・それとも無限ループになるのか・・・明確な対策案を掲示できません
ただ、Private Sub Workbook_Open()イベントで実行しているようなので
実行を少し下位で実行するのはどうでしょう
ExcelからVBA実行ではないようなので
Auto_Open()で検証用VBAを書いて見ました・・・(Shift+)で回避できるのでテストにはいいかなと・・
念のためActivateやParent.Select、DoEventsなどを加えました
標準モジュールModule1に書き直しています
Sub Auto_Open()
Worksheets(1).Activate
Call Module1.AutoSaveToPNG
End Sub
Private Sub AutoSaveToPNG()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Const path As String = "C:\???\???\???\???\???\???\"
Const image1 As String = "image1.png"
Const image2 As String = "image2.png"
Const image3 As String = "image3.png"
Const image4 As String = "image4.png"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each ws In Worksheets
ws.Activate
Select Case ws.Name
Case "報告書"
Call CopyRangeToPNG(ws.Range("D4:N52"), path & image1)
Case "グラフ"
'範囲1
Call CopyRangeToPNG(ws.Range("A1:Y35"), path & image2)
'範囲2
Call CopyRangeToPNG(ws.Range("A36:Y70"), path & image3)
'範囲3
Call CopyRangeToPNG(ws.Range("A71:Y105"), path & image4)
Case Else
GoTo NextSheet
End Select
NextSheet:
Next ws
Worksheets(1).Activate
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Quit
End Sub
Sub CopyRangeToPNG(ByRef rng As Range, ByVal picName As String)
Dim FileSize As Long
Dim pic As ChartObject
Dim tmpChart As Object
rng.CopyPicture xlPrinter, xlPicture
Application.Wait (Now + TimeValue("0:00:03"))
DoEvents
Set pic = ActiveSheet.ChartObjects.Add(0, 0, rng.Width, rng.Height)
pic.Name = "ChartObject3"
With pic.Chart
.Parent.Select
.Export picName
FileSize = FileLen(picName)
If FileLen(picName) <= FileSize Then
Application.Wait (Now + TimeValue("0:00:03"))
DoEvents
.Paste
.Export picName, Filtername:="png"
End If
.Parent.Delete
End With
Set pic = Nothing
End Sub
No.2
- 回答日時:
CopyPictureメソッドはセル範囲のコピーを行い即座に図に変換してクリップボードに送る仕組みです。
が、この「セル範囲のコピー完了前に次の処理に入ってしまいエラーとなると考えると良いかと思います。
PCのバック処理が色々動いてるので、1秒待つのでは足り無い場合が出てくる筈です。
なので、上手く行く時も有るし・・・です。
待ち時間をもう少し長くするとか、「On Error Goto ~」と「Resume ~」を使い、エラー発生時にはコピー直前のラベルにResumeして、もう1回。
とするしか無いと思います。
とにかく、「ピッタリ同期して動け」と言う命令文がVBAには有りませんので・・・。
No.1
- 回答日時:
すみません。
まだ全部を把握できてはいませんが、チョクチョク現われる>FileSize = FileLen(picName?)
>If FileLen(picName?) <= FileSize Then
>・・・
>End If
のIf分は機能していません(=必ずTrueになる)がよろしいのでしょうか?
また、このようなページを見つけましたので、参考にしてください。
セル範囲を画像としてコピーする【CopyPictureメソッド】【ExcelVBA】
https://vba-create.jp/vba-method-copypicture/
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】Excelの特定範囲のセルを画像で保存したい 2 2023/01/25 13:06
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) 【VBAエラー】Nextに対するForがありません 対策について 5 2022/11/21 21:26
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) vbaのエラー対応(実行時エラー7:メモリが不足しています) 4 2023/04/24 00:20
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
このQ&Aを見た人はこんなQ&Aも見ています
-
これまでで一番「情けなかったとき」はいつですか?
これまでの人生で一番「情けない」と感じていたときはいつですか? そこからどう変化していきましたか?
-
初めて自分の家と他人の家が違う、と意識した時
子供の頃、友達の家に行くと「なんか自分の家と匂いが違うな?」って思いませんでしたか?
-
あなたの「プチ贅沢」はなんですか?
お仕事や勉強などを頑張った自分へのご褒美としてやっている「プチ贅沢」があったら教えてください。
-
この人頭いいなと思ったエピソード
一緒にいたときに「この人頭いいな」と思ったエピソードを教えてください
-
泣きながら食べたご飯の思い出
泣きながら食べたご飯の思い出を教えてください。
-
VBA シートをコピーする際に Copyメソッドは失敗しましたのエラーが出てしまいます
Visual Basic(VBA)
-
【VBA】Excelの特定範囲のセルを画像で保存したい
Visual Basic(VBA)
-
VBAマクロ 実行時エラーが出たり出なかったり
Excel(エクセル)
-
-
4
vba クリップボードクリアについて教えてください
その他(プログラミング・Web制作)
-
5
VBA Shapes コピーと名前
Excel(エクセル)
-
6
マクロを実行すると画像がズレてしまいます
その他(Microsoft Office)
-
7
エクセルvbaでの図形のカット(コピー)ペーストについて
Excel(エクセル)
-
8
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
9
【VBA】写真の縦横比を変えずに貼り付ける
Visual Basic(VBA)
-
10
【マクロ】PasteSpecialメソッドにて、コードが動かない理由が分かりません
Excel(エクセル)
-
11
VBA シートのボタン名を変更したい
Visual Basic(VBA)
-
12
VBAでセルを指定した画像のコピー&ペーストを繰り返したい
Excel(エクセル)
-
13
Excel マクロ 画像をリンクせずかつ圧縮して貼りつける方法を教えてください
Excel(エクセル)
-
14
VBA マクロ実行時エラー’1004RangeクラスのPasteSpecialメソッドが失敗
Access(アクセス)
-
15
worksheetクラスのcopyメソッドが失敗しました。
その他(Microsoft Office)
-
16
エクセルVBA 画像を貼り付けるセル位置を指定する方法
Excel(エクセル)
-
17
VBAでエクセルシートを更新(リフレッシュ)する方法を教えて下さい。
Excel(エクセル)
-
18
エクセルVBA/イベント発生でコピペ不能はなぜ?
Excel(エクセル)
-
19
エクセルのVBAでクリップボードにコピーした画像をpng(or jpg or bmp)保存したい
Visual Basic(VBA)
-
20
複数の条件に合う行番号を取得するには
その他(Microsoft Office)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
UserForm1.Showでエラーになり...
-
お助けください!VBAのファイル...
-
【VBA】ワークブックを開く時に...
-
On ErrorでエラーNoが0
-
VBAでfunctionを利用しようとし...
-
String""から型'Double'への変...
-
文字列内で括弧を使うには
-
マクロで"#N/A"のエラー行を削...
-
【VB.NET】 パワポ操作を非表示で
-
SQLでエラーです。
-
Excel vbaについての質問
-
ACCESSで値を代入できないとは?
-
オブジェクト型の変数にフォー...
-
バッチファイルからVBA実行でエ...
-
VB6とVB.NETでNullの扱いが違う?
-
「実行時エラー '3167' レコー...
-
実行時エラー 438 の解決策をお...
-
Excel VBA 構文エラーについて...
-
VBでSQL文のUPDATE構文を使った...
-
グラフを表示するとき「’~’メソ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
UserForm1.Showでエラーになり...
-
お助けください!VBAのファイル...
-
VBAでfunctionを利用しようとし...
-
【VBA】ワークブックを開く時に...
-
String""から型'Double'への変...
-
マクロで"#N/A"のエラー行を削...
-
文字列内で括弧を使うには
-
VBA データ(特定値)のある最...
-
On ErrorでエラーNoが0
-
LaTeXのエラーについて(コンパ...
-
Filter関数を用いた結果、何も...
-
ACCESSで値を代入できないとは?
-
Excel vbaについての質問
-
インポート時のエラー「データ...
-
ApplicationとWorksheetFunctio...
-
実行時エラー 438 の解決策をお...
-
VBでSQL文のUPDATE構文を使った...
-
pythonのopenpyxlについて
-
【Access】Excelインポート時に...
-
SQLでエラーです。
おすすめ情報