Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


13435 / 13646 ツリー ←次へ | 前へ→

【5364】シートのJPEGファイル作成 ねこぽん 03/5/8(木) 13:31 質問
【5371】Re:シートのJPEGファイル作成 bykin 03/5/8(木) 22:25 発言
【5392】Re:シートのJPEGファイル作成 ねこぽん 03/5/9(金) 16:58 お礼
【5393】Re:シートのJPEGファイル作成 こう 03/5/9(金) 18:49 回答
【5413】Re:シートのJPEGファイル作成 ねこぽん 03/5/12(月) 11:25 お礼
【5416】Re:シートのJPEGファイル作成 bykin 03/5/12(月) 13:00 回答
【5430】Re:シートのJPEGファイル作成 ねこぽん 03/5/13(火) 13:02 お礼
【5411】Re:シートのJPEGファイル作成 bykin 03/5/11(日) 18:43 回答
【5414】Re:シートのJPEGファイル作成 ねこぽん 03/5/12(月) 11:36 お礼
【5422】Re:シートのJPEGファイル作成 bykin 03/5/12(月) 22:38 回答
【5431】Re:シートのJPEGファイル作成 ねこぽん 03/5/13(火) 14:19 お礼
【5437】Re:シートのJPEGファイル作成 bykin 03/5/13(火) 22:07 回答
【5439】Re:シートのJPEGファイル作成 bykin 03/5/14(水) 0:05 発言
【5449】Re:シートのJPEGファイル作成 ねこぽん 03/5/14(水) 15:16 お礼

【5364】シートのJPEGファイル作成
質問  ねこぽん  - 03/5/8(木) 13:31 -

引用なし
パスワード
   入力シートからインプットしたデータを印刷用シートに帳票レイアウトで表示し印刷用シートをプリントアウトしていたのですが、印刷しないでイメージをJEPGファイルとしてパソコン内に保存していきたいのですが、調べましたところJEPGで保存できるというヘルプ内容が見当たりませんでした。
ExcelではビットマップかHTMLでしか保存できないのでしょうか?
JPEGで保存できるとしたらどのように記述したらできるのでしょうか?
ご存知の方がいましたら教えて下さい。

宜しくお願いします。

【5371】Re:シートのJPEGファイル作成
発言  bykin  - 03/5/8(木) 22:25 -

引用なし
パスワード
   こんばんわ。

直接の回答ってわけやないねんけど・・・
印刷イメージを印刷せずいきなりJpegに変換して保存できるかどうかは知りまへんが、
こういうのってPDFファイルにしたりするんやないかな?
PDFやったらAcrobatを入れて、普通に印刷する代わりに専用のプリンタドライバに出力
するだけで、印刷イメージがファイルになるねんけどな。
Acrobatはお高いから同じような他のソフト使ってもええねんけど。
↓こんなんとか
http://www.nsd.co.jp/share/pdffact/

Jpegやないと困るってことやったらかんにんな。
ほな。

【5392】Re:シートのJPEGファイル作成
お礼  ねこぽん  - 03/5/9(金) 16:58 -

引用なし
パスワード
   bykin さん、こんばんわ。

遅い時間なのに返信おおきに。

>Jpegやないと困るってことやったらかんにんな。
実は後続処理がJPEGしか受付けられないシステムなので
Jpegやないと困るってやつなんですわ。

他の案まで出してくれたのにすみません。
& ありがとうございました。

【5393】Re:シートのJPEGファイル作成
回答  こう E-MAIL  - 03/5/9(金) 18:49 -

引用なし
パスワード
   ねこぽんさん,こんにちわ。

>ExcelではビットマップかHTMLでしか保存できないのでしょうか?
>JPEGで保存できるとしたらどのように記述したらできるのでしょうか?

私も直接の回答ではありませんが...^_^;
BMPファイルに保存後,JPEGファイルに変換してはいかがでしょうか?
駄目?

【5411】Re:シートのJPEGファイル作成
回答  bykin  - 03/5/11(日) 18:43 -

引用なし
パスワード
   こんばんわ。

JPEGで出力する方法をいろいろ調べてました。
グラフに貼り付けたら出来る(サイズ合わせにちょっと工夫が必要)ようです。
出力したいセル範囲を選択して下のマクロを実行してみてください。
(出力ファイル名は適宜変更してください)

Sub test()
  Dim sw As Variant
  If TypeName(Selection) <> "Range" Then
    MsgBox "セルが選択されていません", vbCritical
    Exit Sub
  End If
  If Selection.Areas.Count > 1 Then
    MsgBox "複数のセル範囲に対しては実行できません", vbCritical
    Exit Sub
  End If
  sw = False
  Do
    sw = Application.InputBox("0:画面に合わせる 1:用紙に合わせる", Type:=1)
    If VarType(sw) = vbBoolean Then Exit Sub
    If sw = 0 Or sw = 1 Then Exit Do
  Loop
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    Selection.CopyPicture IIf(sw = 0, xlScreen, xlPrinter)
    With Worksheets.Add
      Charts.Add.Location Where:=xlLocationAsObject, Name:=.Name
      With .ChartObjects(1)
        .Border.LineStyle = xlLineStyleNone
        .Chart.Paste
        .Height = Selection.Height + (.Chart.ChartArea.Top) * 2
        .Width = Selection.Width + (.Chart.ChartArea.Left) * 2
        .Chart.Export Filename:="C:\Test.jpg", Filtername:="JPG"
      End With
      .Delete
    End With
    .DisplayAlerts = True
    .ScreenUpdating = True
  End With
End Sub

「1:用紙に合わせる」を選択したら印刷するときの形でデータを取得するので
セルの枠線なんかは非表示になります。
但し、その場合でも実際の印刷イメージとは若干異なります(^^;;
結構いい線いってるとは思うけど・・・

試してみてな。
ほな。

【5413】Re:シートのJPEGファイル作成
お礼  ねこぽん  - 03/5/12(月) 11:25 -

引用なし
パスワード
   こう さん こんにちわ

知人に JPEGSave.dll を教えて貰い使ってみて結構快適だったのですが
どうもこれを使用する人に配布するという点で丁度話が煮詰まっているところで
最悪こうさんの言われる方法がベストかなと考えていたところでした。
もう一つ案を返信してくださっている人がいるのでBMPから変換を決定する前に
試してみようと思っています。

アイディアをありがとうございました。


>ねこぽんさん,こんにちわ。
>
>>ExcelではビットマップかHTMLでしか保存できないのでしょうか?
>>JPEGで保存できるとしたらどのように記述したらできるのでしょうか?
>
>私も直接の回答ではありませんが...^_^;
>BMPファイルに保存後,JPEGファイルに変換してはいかがでしょうか?
>駄目?

【5414】Re:シートのJPEGファイル作成
お礼  ねこぽん  - 03/5/12(月) 11:36 -

引用なし
パスワード
   bykin さん こんにちわ。

ここまで詳細なモジュールをありがとうございます。
やってみましたら、かなりいい線いってました。
グラフのサイズ合わせは、コピー元のシートを印刷サイズにして、
それを枠で選択したサイズをそのままグラフのサイズに摘要しました。
ら、上手く行ったのですが、不可解な動きが。。。

マクロで一気に実行するとグラフのサイズがとても小さく豆粒文字になります。
が、デバッグモードで実行し、「.Chart.Paste」でいったんとめてグラフを確認すると丁度指定したサイズで、その後JPGファイルにしても指定したサイズのままなのです。
何が違うのでしょうか。
タイマーのセットをして時間を稼がないとサイズ合わせが出来ないなんて事はないですよね?
もし、他に追加しなければならない記述があるのでしたら教えてください。

宜しくお願いします。

JPG_Sheet にはコピーする内容のシート名
JPG_Sele にはコピーする範囲指定がDim で定義しています。

  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    Selection.CopyPicture 0
    With Worksheets.Add
      Charts.Add.Location Where:=xlLocationAsObject, Name:=.Name
      With .ChartObjects(1)
        .Border.LineStyle = xlLineStyleNone
        .Height = Sheets(JPG_Sheet).Range(JPG_Sele).Height
        .Width = Sheets(JPG_Sheet).Range(JPG_Sele).Width
        .Chart.Paste
        .Chart.Export FileName:="C:\Test.jpg", FilterName:="JPG"
      End With
      .Delete
    End With
    .DisplayAlerts = True
    .ScreenUpdating = True
  End With

【5416】Re:シートのJPEGファイル作成
回答  bykin  - 03/5/12(月) 13:00 -

引用なし
パスワード
   こんにちわ。

時間ないんで、これだけ・・・

Selection.CopyPicture 0

Selection.CopyPicture xlPrinter

ってやったらあきまへんか?
CopyPicture の引数 Appearance で使える値は
xlScreen(=1) と xlPrinter(=2) だけで、0は無いと思うねんけど・・・
定数で指定してみてください。

ほな。

【5422】Re:シートのJPEGファイル作成
回答  bykin  - 03/5/12(月) 22:38 -

引用なし
パスワード
   こんばんわ。

昼間のカキコはくっつける場所間違えてしもた(^^;;
・・・で、家帰ってコードみてみました。

xlPrinter は修正するとして、他の箇所でっけど、
Selection の扱いを間違ってるから変になったんやないかな?

わてのコードではちょっとややこしいけど前半に出てくる Selection と
後半の Selection とは対象(参照先)が違うんです。
前半(CopyPicture まで)では選択したセル範囲の意味やねんけど、
.Height = Selection.Height + (.Chart.ChartArea.Top) * 2
の箇所では、貼り付けた図が対象に変化してます。

で、CopyPicture の部分で Selection をコピーするって命令になってるわけやけど、
その前に Sheets(JPG_Sheet).Range(JPG_Sele) は選択されてるんでっか?
肝心の部分が省略されててわからんのやけど、もし選択してないんやったら
全然別の今選択してる部分をコピーしてる可能性もあります。
ねこぽんはんの使い方やったらここは Selection やのうて、セル範囲を明示したほうが
ええと思います。

後半部分で Selection の参照先が変化してるってのは、
.Height = Selection.Height + (.Chart.ChartArea.Top) * 2
の前の .Chart.Paste を実行すると選択されてるものがセル範囲から図に変わるからです。
つまり、この部分については Selection のままにしておけばええってことです。
コードの順番も元コードのように .Chart.Paste の後にサイズ調整をやらんとあきまへん。

それと、「工夫が必要」って書いたのは貼り付けてから図のサイズに合わせるだけでは
右と下がちょん切れてまうので、ちょっとだけサイズを大きくする必要があるんです。
ChartObjects の中の ChartArea の Left や Top が 0 ではなく、変更できないからです。
せやから + (.Chart.ChartArea.Top) * 2 でサイズ調節してるわけです。

・・・ってことで、↓これでどうでっしゃろ?

Sub test2()
  Dim JPG_Sheet As String
  Dim JPG_Sele As String
  
  JPG_Sheet = "Sheet1"
  JPG_Sele = "A1:C5"
  
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    Worksheets(JPG_Sheet).Range(JPG_Sele).CopyPicture xlPrinter
    With Worksheets.Add
      Charts.Add.Location Where:=xlLocationAsObject, Name:=.Name
      With .ChartObjects(1)
        .Border.LineStyle = xlLineStyleNone
        .Chart.Paste
        .Height = Selection.Height + (.Chart.ChartArea.Top) * 2
        .Width = Selection.Width + (.Chart.ChartArea.Left) * 2
        .Chart.Export Filename:="C:\Test.jpg", FilterName:="JPG"
      End With
      .Delete
    End With
    .DisplayAlerts = True
    .ScreenUpdating = True
  End With
End Sub

シート名やセル範囲は適当に書いてるんで変更してください。
わての環境ではうまいこといきました。
試してみてな。
ほな。

【5430】Re:シートのJPEGファイル作成
お礼  ねこぽん  - 03/5/13(火) 13:02 -

引用なし
パスワード
   bykin さん こんにちわ

>CopyPicture の引数 Appearance で使える値は
>xlScreen(=1) と xlPrinter(=2) だけで、0は無いと思うねんけど・・・
>定数で指定してみてください。
>

あり?
失礼しました。

【5431】Re:シートのJPEGファイル作成
お礼  ねこぽん  - 03/5/13(火) 14:19 -

引用なし
パスワード
   bykin さん こんにちわ

確かにこの記述で上手くいきました。
ありがとうございます。

質問ついでにもう一つお伺いします。
実は、印字内容は縦方向の印刷内容で、JPEGを印刷したときにA4の縦用紙で印字できるようにイメージを保存したいのです。

これを
>    Worksheets(JPG_Sheet).Range(JPG_Sele).CopyPicture xlPrinter
>    Worksheets(JPG_Sheet).Range(JPG_Sele).CopyPicture xlScreen, xlBitmap
に変更をすると印字方向は良いのですが、中身が真っ白です。
なんでやろ?

>Sub test2()
>  Dim JPG_Sheet As String
>  Dim JPG_Sele As String
>  
>  JPG_Sheet = "Sheet1"
>  JPG_Sele = "A1:C5"
>  
>  With Application
>    .ScreenUpdating = False
>    .DisplayAlerts = False
>    Worksheets(JPG_Sheet).Range(JPG_Sele).CopyPicture xlScreen, xlBitmap
>    With Worksheets.Add
>      Charts.Add.Location Where:=xlLocationAsObject, Name:=.Name
>      With .ChartObjects(1)
>        .Border.LineStyle = xlLineStyleNone
>        .Chart.Paste
>        .Height = Selection.Height + (.Chart.ChartArea.Top) * 2
>        .Width = Selection.Width + (.Chart.ChartArea.Left) * 2
>        .Chart.Export Filename:="C:\Test.jpg", FilterName:="JPG"
>      End With
>      .Delete
>    End With
>    .DisplayAlerts = True
>    .ScreenUpdating = True
>  End With
>End Sub
>

【5437】Re:シートのJPEGファイル作成
回答  bykin  - 03/5/13(火) 22:07 -

引用なし
パスワード
   こんばんわ。

>実は、印字内容は縦方向の印刷内容で、JPEGを印刷したときにA4の縦用紙で印字できるように
>イメージを保存したいのです。
>これを
>>    Worksheets(JPG_Sheet).Range(JPG_Sele).CopyPicture xlPrinter
>>    Worksheets(JPG_Sheet).Range(JPG_Sele).CopyPicture xlScreen, xlBitmap
>に変更をすると印字方向は良いのですが、中身が真っ白です。
>なんでやろ?

最初この文章読んだとき、何のこっちゃ判らんかってんけど、実験してみて判りました。
A4縦サイズのセル範囲を対象にして実行してみても、コピーした図が小さく貼り付いてしもて
出力されるJPEGも横長の小さいもんになってまうんやね。

で、いろいろ実験してみたけど、これはエクセル君をちょっとびっくりさせんとあかんみたいです。
びっくりってのは、OnTime メソッドを使って外部から操作するってこと。
コードの記述は合ってるはずやのに、なぜか言うこときかんエクセル君に無理やり処理させるために、
わてがときどき使う奥の手です(^^;;

で、コード考えてみました。データを渡すのにモジュールレベルの変数を使ってます。

Private TempSheet As Worksheet
Private TargetArea As Range
Private TargetChart As ChartObject
Private CurrentSheet As Worksheet

Sub test()
  Dim JPG_Sheet As String
  Dim JPG_Sele As String
  
  JPG_Sheet = "Sheet1"
  JPG_Sele = "A1:I51"
  Set TargetArea = Worksheets(JPG_Sheet).Range(JPG_Sele)
  Set CurrentSheet = ActiveSheet
 
  With Application
    .ScreenUpdating = False
    TargetArea.CopyPicture xlPrinter
    Set TempSheet = Worksheets.Add
    With TempSheet
      Charts.Add.Location Where:=xlLocationAsObject, Name:=.Name
      Set TargetChart = .ChartObjects(1)
      With TargetChart
        .Border.LineStyle = xlLineStyleNone
        .Height = TargetArea.Height + (.Chart.ChartArea.Top) * 2
        .Width = TargetArea.Width + (.Chart.ChartArea.Left) * 2
      End With
    End With
    CurrentSheet.Activate
    .OnTime Now(), "test_main"
  End With
End Sub

Sub test_main(Optional ByVal Dummy As Boolean)
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    TempSheet.Activate
    With TargetChart
      .Chart.Paste
      .Height = Selection.Height + (.Chart.ChartArea.Top) * 2
      .Width = Selection.Width + (.Chart.ChartArea.Left) * 2
      .Chart.Export Filename:="C:\Test.jpg", FilterName:="JPG"
    End With
    TempSheet.Delete
    CurrentSheet.Activate
    .DisplayAlerts = False
    .ScreenUpdating = False
  End With
End Sub

一応これでうまいこといってると思うねんけど・・・

test_main の (Optional ByVal Dummy As Boolean) ってのはマクロ実行ダイアログに
マクロが表示されないようにするための・・・奥の手(^^;;

うまいこといかんかったらかんにんな。
ほな。

【5439】Re:シートのJPEGファイル作成
発言  bykin  - 03/5/14(水) 0:05 -

引用なし
パスワード
   あちゃちゃ・・・ちょっと書き間違い(^^;;
test_main の最後の
.DisplayAlerts = False
.ScreenUpdating = False
は、どっちも True に変更しておいてください。

すんまへーん。

【5449】Re:シートのJPEGファイル作成
お礼  ねこぽん  - 03/5/14(水) 15:16 -

引用なし
パスワード
   bykin さん こんにちわ

でけたぁ〜!!(^v^)

bykin さんのおかげでやっと完成いたしました。
完璧です!!
長々とお付き合いいただきましてありがとうございました。

Excelは私の分野ではないので助かりました。
(Accessにはたまに質問をかきこしてるんやけど)
遅い時間のレス&テスト、ホンマにありがとさんでした。

13435 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free