EXCEL2000(windows XP)環境にて、現在アクティブなワークシートにあるグラフ(埋め込みグラフ)を連続印刷する方法を教えてください。
例えば、ワークシート中に50枚のグラフが配置されているとき、これらを全て印刷したいのですが、いちいち印刷メニューからだと手間がかかり、これを何とかできればと考えています。
アクティブなワークシート中の任意の選択されたグラフを印刷できるとナオいいです。
更に、PPT等に1グラフ/1ページで出力(カット&ペースト)をマクロやVBA等で自動できれば最高です。
ここを見れば、にたようなことができるという情報でも歓迎します。
どうぞよろしくお願いいたします。
No.6ベストアンサー
- 回答日時:
なるほど、いいアイディアですね^^
では、さらにこのアイディアを応用して、ワークシート経由ではなく、
> oChart.Copy
> ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)"
> Selection.Cut
↓
oChart.CopyPicture xlScreen, xlPicture
直接拡張メタファイルでクリップボードにコピーするようにするとか?
> office系アプリの操作に関して参考になるソース
有名どこで。
http://www.moug.net/
http://www.asahi-net.or.jp/~ef2o-inue/top01.html
http://www.officetanaka.net/
意外と重宝。
http://support.microsoft.com/select/?target=hub
Google で検索すればいっぱいありますよ。その中から「お気に入り」を
探すこともスキルアップには大切なことだと思います^^
お返事遅くなりスイマセン。
質問者です。
ためしてみました。スゴイ。はやい。生産性が格段に高くなりました(特に継続的にEXCELを使いたいときに)
ご紹介いただいたURLにていろいろ勉強させていただきます。
どうもありがとうございました。
No.7
- 回答日時:
こんばんは venzoです。
>oChart.CopyPicture xlScreen, xlPicture
2000の環境で動作確認しました。
CopyPictureというメソッドは知りませんでした。
こちらの方がスマートだし、処理速度も速いです。すばらしい!
>このようなVBAを使ったoffice系アプリの操作に関して参考になるソース
私の場合、Excelでマクロを記録して、それを改造することが多いです。
分からないことは、Google検索が中心です。
あまり参考にならないですね(^^;
最新バージョンのマクロ、ほんとうに早いです。
マクロの勉強方法。そうかマクロを記録すればいいんですね。
特にメソッド関係はそこから学習できることよくわかりました。
どうもありがとうございます。
No.5
- 回答日時:
思いつきました。
PowerPointで出来ないなら、ExcelでPasteSpecialすれば良い。>' PP スライド追加し、拡張メタファイル Excel グラフを貼り付け
>oChart.Copy
↑この部分を↓こう変更。
' PP スライド追加し、拡張メタファイル Excel グラフを貼り付け
oChart.Copy
ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)"
Selection.Cut
いったんExcelの方にメタファイルで貼り付けて、切り取って、PPTに貼り付け。
これでどうでしょう?
この回答への補足
venzoさん、KenKen_SPさん
本当にありがとうございました。
別質問なので本当は別のと頃で聞いた方がよいのだと思いますが、このようなVBAを使ったoffice系アプリの操作に関して参考になるソース(海外に居住しているためWebページの方が助かります)がありましたら教えてください。
自分でも聞いているばかりでなくて、基本的なところを勉強して自力でも解決できるようになりたいと考えております。
venzoさん、こんにちは。
できました!!
サイズも非常に小さくてGOODです。
どうもありがとうございます。
これで当初考えたことが全て完璧に実現することができました。
No.4
- 回答日時:
こんにちは。
KenKen_SP です。> PowerPoint2000には、メソッド"PasteSpecial"が無いようです。
大量のグラフが埋め込まれる場合を考慮し、拡張メタファイルで
貼り付けた方が良いかなと思ったのですが...
venzo さん、理由がわかってスッキリしました。
ありがとうございました。
KenKen_SPさん
そうなんです。実はエクセルのファイルが10MBをこえており、かつ、グラフが大量にあるので貼り付けるときに、2000で動作するバージョンだと動作はするのですが、大変時間がかかり(本質的には自動なので問題なしですが)、かつ、大きくなってしまいます。
可能なら拡張メタファイルでできたらと思っていますが、メソッドがないとなると難しそうですね。
一度暫定的なエクセルファイルを作成してそちらに図をコピペしてから実行するなど工夫して回避できるか試してみるつもりです。
どうもありがとうございました。
No.3
- 回答日時:
こんにちは、お邪魔します。
Excel2000、PowerPoint2000で確認しました。
PowerPoint2000には、メソッド"PasteSpecial"が無いようです。
ヘルプで検索しましたがヒットしませんでした。
オブジェクトブラウザで検索してもダメでした。
代わりに"Paste"を使うしかないと思います。
#1のソースの場合
>ppSld.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
ppSld.Shapes.Paste
#2のソースの場合
>With ppSld.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With ppSld.Shapes.Paste
上記の変更でどちらのソースでも動きました。
No.2
- 回答日時:
Excel2002+PowerPoint2002 では動きますね.... Office2000 環境がないので
どうも良くわからないのですが、バージョンの差異なのかもしれません。
試しに...
> ppSld.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
> ' PP グラフ位置・サイズを最大になるように補正
> With ppSld.Shapes(1)
> .LockAspectRatio = msoFalse
> .Top = 0
> .Left = 0
> .Height = sngH
> .Width = sngW
> End With
の部分を下記のように変えてみたらどうなりますか?
' PP グラフ位置・サイズを最大になるように補正
With ppSld.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
.LockAspectRatio = msoFalse
.Top = 0
.Left = 0
.Height = sngH
.Width = sngW
End With
No.1
- 回答日時:
こんにちは。
KenKen_SP です。PP の VBA はほとんど使わないので、勉強ついでにコードを書いてみました。
こんな感じで良かったのかな? ほとんどテストしてないけど。
# GetSelectedChats 関数部はもっと良い方法がありそうな気がします
標準モジュールにコピペして下さい。
Sub 選択グラフを印刷()
Dim colCharts As Collection
Dim oChart As Object
On Error GoTo ERROR_HANDLER
Set colCharts = GetSelectedChats
If Not colCharts Is Nothing Then
For Each oChart In colCharts
' プレビューしない場合は Preview:=False に修正
oChart.Chart.PrintOut Preview:=True
Next
End If
Set colCharts = Nothing
TERMINATE:
On Error GoTo 0
Exit Sub
ERROR_HANDLER:
MsgBox Err.Description, vbCritical
Resume TERMINATE
End Sub
Sub 選択グラフを新規PPにコピペ()
' 拡張メタファイルで貼り付けてます(Excel2002+PowerPoint2002)
Dim ppApp As Object ' PowerPoint.Application
Dim ppPst As Object ' PowerPoint.Presentation
Dim ppSld As Object ' PowerPoint.Slide
Dim colCharts As Collection
Dim oChart As Object
Dim sngW As Single
Dim sngH As Single
Dim i As Long
' PowerPoint(=PP) 定数
Const ppLayoutBlank = 12
Const ppPasteEnhancedMetafile = 2
' 選択されている ChartObject 取得
Set colCharts = GetSelectedChats
' 終了条件:: 選択されたグラフが無い
If colCharts Is Nothing Then Exit Sub
' 終了条件:: PP が起動できない
On Error Resume Next
Set ppApp = CreateObject("PowerPoint.Application")
If ppApp Is Nothing Then
On Error GoTo ERROR_HANDLER
Err.Raise 1000, , "PowerPoint の起動に失敗しました"
End If
On Error GoTo ERROR_HANDLER
' PP を表示
ppApp.Visible = msoTrue
' PP 新規プレゼンテーション作成
Set ppPst = ppApp.Presentations.Add(WithWindow:=True)
' PP 画面最大サイズを取得
With ppPst.PageSetup
sngH = .SlideHeight
sngW = .SlideWidth
End With
' Excel グラフの貼り付け開始
i = 1
For Each oChart In colCharts
' PP スライド追加し、拡張メタファイル Excel グラフを貼り付け
oChart.Copy
Set ppSld = ppPst.Slides.Add(Index:=i, _
Layout:=ppLayoutBlank)
ppSld.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
' PP グラフ位置・サイズを最大になるように補正
With ppSld.Shapes(1)
.LockAspectRatio = msoFalse
.Top = 0
.Left = 0
.Height = sngH
.Width = sngW
End With
i = i + 1
Next
TERMINATE:
On Error GoTo 0
Set colCharts = Nothing
Set ppApp = Nothing
Set ppPst = Nothing
Set ppSld = Nothing
Exit Sub
ERROR_HANDLER:
MsgBox Err.Description, vbCritical
Resume TERMINATE
End Sub
' // 選択された ChartObject を Collection で返す
Private Function GetSelectedChats() As Collection
Dim Obj As Object
Dim bFoundChart As Boolean
Dim colCharts As Collection
On Error GoTo ERROR_HANDLER
' 終了条件:: Selection が Range
If UCase$(TypeName(Selection)) = "RANGE" Then Exit Function
' Selection から ChartObject を探す
Set colCharts = New Collection
If UCase$(TypeName(Selection)) = "DRAWINGOBJECTS" Then
' 複数選択のとき
For Each Obj In Selection
If UCase$(TypeName(Obj)) = "CHARTOBJECT" Then
colCharts.Add Obj
End If
Next
Else
' 単一選択のとき
Set Obj = Selection
If UCase$(TypeName(Obj)) <> "CHARTOBJECT" Then
Do While UCase$(TypeName(Obj)) <> "APPLICATION"
Set Obj = Obj.Parent
If UCase$(TypeName(Obj)) = "CHARTOBJECT" Then
bFoundChart = True
Exit Do
End If
Loop
Else
bFoundChart = True
End If
If bFoundChart Then colCharts.Add Obj
End If
' Return
If colCharts.Count > 0 Then Set GetSelectedChats = colCharts
TERMINATE:
On Error GoTo 0
Set colCharts = Nothing
Exit Function
ERROR_HANDLER:
Set GetSelectedChats = Nothing
Resume TERMINATE
End Function
ありがとうございました。
前半の印刷するバージョンは問題なく動作しました。
後半のPPTの方ですが、パワーポイントとエクセルのバージョンが2000であることが影響するのか、実行すると(印刷するバージョンで選択した同じスライドを選択した状態)、以下のようなエラーが発生します。
「オブジェクトは、このプロパティまたはメソッドをサポートしていません」
マイクロソフトエクセルからのエラーとなります。
エラーが発生する前にパワーポイントが起動し、1枚目にまっさらのスライドが挿入されたエラーとなります。
ブレイクポイントを設定してどこで止まるかを見たところ、
With ppSld.Shapes(1)
の行でエラーが発生しているようです。
なにか回避方法等がおもいつきましたら教えてください。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルにおける、グラフの指...
-
エクセルでグラフタイトルが折...
-
パワーポイントに貼り付けたエ...
-
エクセルグラフの数値軸(Y)の...
-
たくさん作った同じ設定のグラ...
-
EXCELで海の潮見表(タイドグラ...
-
エクセルのグラフタイトル
-
wordでグラフを挿入したいので...
-
Excel:とびとびの日付のデータ...
-
一太郎にエクセルからコピーし...
-
エクセルのグラフの一部拡大
-
イラレのグラフがグループ解除...
-
エクセルグラフの一括設定。
-
デスクトップに線が書けるソフ...
-
エクセル(Excel)の目盛りの一...
-
エクセルのグラフのフォーマッ...
-
二つの3次関数の曲線を描きたい
-
EXCEL:3-D 等高線グラフの軸の...
-
[Office365]エクセルで作成した...
-
~エクセル~円グラフのみを抽...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルでグラフタイトルが折...
-
エクセルにおける、グラフの指...
-
たくさん作った同じ設定のグラ...
-
パワーポイントに貼り付けたエ...
-
エクセルグラフの一括設定。
-
EXCEL・複数ある円グラフの円の...
-
~エクセル~円グラフのみを抽...
-
エクセルのグラフの一部拡大
-
エクセル折れ線グラフについて...
-
エクセルグラフの数値軸(Y)の...
-
エクセルで作業ごとの時間をグ...
-
イラレのグラフがグループ解除...
-
エクセルのグラフが作成した通...
-
コロナって今でも流行っている...
-
Excelで作ったグラフをIllustra...
-
エクセル(Excel)の目盛りの一...
-
pc版apexをしているとpcが落ちる
-
EXCELでの棒グラフの太さについて
-
エクセル:ぴったり重なった後...
-
(エクセル)グラフにテキスト...
おすすめ情報