Excel VBA質問箱 IV

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

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


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

【67196】ブックのサイズを縮小する Abebobo 10/11/15(月) 10:30 質問[未読]
【67200】Re:ブックのサイズを縮小する Jaka 10/11/15(月) 11:52 発言[未読]
【67201】Re:ブックのサイズを縮小する Abebobo 10/11/15(月) 12:13 お礼[未読]
【67205】Re:ブックのサイズを縮小する Jaka 10/11/15(月) 14:15 発言[未読]
【67207】Re:ブックのサイズを縮小する Abebobo 10/11/15(月) 20:42 お礼[未読]
【67219】間違い修正 Jaka 10/11/16(火) 9:29 発言[未読]
【67222】Re:間違い修正 Abebobo 10/11/16(火) 10:03 発言[未読]
【67221】Re:ブックのサイズを縮小する Abebobo 10/11/16(火) 10:00 お礼[未読]
【67246】Re:ブックのサイズを縮小する Jaka 10/11/17(水) 13:38 発言[未読]
【67257】Re:ブックのサイズを縮小する Abebobo 10/11/17(水) 18:17 お礼[未読]
【67210】Re:ブックのサイズを縮小する kanabun 10/11/15(月) 22:31 発言[未読]
【67211】Re:ブックのサイズを縮小する Abebobo 10/11/15(月) 22:53 お礼[未読]
【67236】Re:ブックのサイズを縮小する ichinose 10/11/17(水) 7:11 発言[未読]
【67238】Re:ブックのサイズを縮小する Abebobo 10/11/17(水) 9:48 お礼[未読]

【67196】ブックのサイズを縮小する
質問  Abebobo  - 10/11/15(月) 10:30 -

引用なし
パスワード
   質問させてください。

最近、デジカメや記録媒体の性能がどんどん上がってきています。
それに伴い、写真のサイズを気にせずにエクセルブックにべたべた貼り付ける人もどんどん増えていきます。で、『サーバーが一杯になっちゃんですけど〜』って言われます。 見てみるとエクセルブックが、21MBを最大に5MBクラスがうじゃうじゃいます。

Sub 写真軽量()

Dim ShP As Object
Dim New_ShP As Object
Dim ShP_top As Double
Dim ShP_left As Double
Dim Tar_WB As Workbook

Set Tar_WB = ActiveWorkbook

With Tar_WB

 For Each ShP In .ActiveSheet.Shapes
  If ShP.Type = 13 Then
   Debug.Print ShP.Type
 '  ShP.Select
 '  Stop
   ShP_top = ShP.Top
   ShP_left = ShP.Left
   ShP.CopyPicture Appearance:=xlScreen, Format:=xlPicture
   ShP.TopLeftCell.Select
   Set New_ShP = ActiveSheet.Pictures.Paste
   New_ShP.Top = ShP.Top
   New_ShP.Left = ShP.Left
   ShP.Delete
  End If
 
 Next
End With


End Sub

こんなの造って見ましたけど、もっとかっこよいコードのアドバイスをお願いします。

図のコピー⇒貼り付け⇒図の微調整⇒オリジナル図の削除
のコードです。

【67200】Re:ブックのサイズを縮小する
発言  Jaka  - 10/11/15(月) 11:52 -

引用なし
パスワード
   ▼Abebobo さん:
>図のコピー⇒貼り付け⇒図の微調整⇒オリジナル図の削除
>のコードです。

確認してないけど、これで軽量と言うかファイルサイズが小さくなるのでしょうか?
逆に大きくなるような気がしますけど。
画像の形式がどうなっているのか、よく見てませんけど画質を下げている?
新規ブックに張りなおした方がいいのでは?

For Each ShP In .ActiveSheet.Shapes
  ↓の方がかっこいい?
For Each Shp In ActiveSheet.Pictures

画像は画像として保存しておいた方がいいような気がします。
わざわざ画質を下げる事ないような気がするので。
私は、エロ画像をフォーム上のイメージに保存させた事があるけど、
やはり重くなりましたね。
で、10M越えでやめました。

画像回覧は専用のフリーソフトを使った方がいいのでは?
Sin???何とかってソフトで、全体の画像がアイコンの状態で見れるし。
(なんていうのか出てこない。)
スライドショーでも見れるし....。

【67201】Re:ブックのサイズを縮小する
お礼  Abebobo  - 10/11/15(月) 12:13 -

引用なし
パスワード
   Jaka さん 返信ありがとうございます。

>これで軽量と言うかファイルサイズが小さくなるのでしょうか?
結構なります。
たまに、少し大きくなるファイルがありました。

>新規ブックに張りなおした方がいいのでは?
基本は、ブックをコピーしてそれをいじります。

>For Each Shp In ActiveSheet.Pictures
これ! If でタイプわけしなくて良くなりました。ありがとうございます。

>画像回覧は専用のフリーソフトを使った方がいいのでは?
古くからPCいじってる人は、縮専?というソフトで画像を圧縮してから
エクセルに貼っています。最近始めた人が・・・

ブックのレイアウトは、
写真が貼ってあってそこに噴出しでコメント
その右にそれにまつわるグラフor表 そんな感じです。

>画像の形式がどうなっているのか、
エクセルに貼り付けてある画像を調べることってできますか?

>私は、エロ画像をフォーム上のイメージに保存させた事があるけど、
そういえば、最近自宅のPC内に 菅野美○ の写真を発見しました。
もう13年位前になりますかね〜 ヌード・・・当時は衝撃的でした

【67205】Re:ブックのサイズを縮小する
発言  Jaka  - 10/11/15(月) 14:15 -

引用なし
パスワード
   ▼Abebobo さん:
>エクセルに貼り付けてある画像を調べることってできますか?
なんかなんとかって種類に自動で返還されちゃうみたいなので、
出来ないんじゃないかと???


おまけ

前に作ったやつをほったらかしたままなので完璧では無いです。
適当に画像が見れればいいというやつです。

画像回覧用ユーザーフォーム

フォーム上コントロール

Frame1 を作り、その中に Image1 を作る。
Frame1のプロパティ KeepScrolBarsVisible を3に設定。
(右、下にスクロールバーが表示される。)

フレームの下に
CommandButton1、3、4、5 配置。(3,4,5は、まだ未完。)
フレームの大きさ、適当だけれど、150x150ぐらいでいいんじゃないかと。
そのぐらいの大きさで作るのを想定したコードなので。
☓☓画像こっそり回覧バージョン??

フレームの右辺りに
ListBox1(画像ファイル名展開)
その下に CommandButton2

1番下にTextBox1。(画像フォルダプルパス記入用)

使用法、

CommandButton1を押して、画像が入っているフォルダを指定するか、
直接、TextBox1のフォルダのフルパスを記入。
これを見て、回覧用ファイルを検索し、ListBox1に表示します。

リストボックスに表示されたファイルを選択すると、イメージに読み込まれます。

尚、ろくにエラー処理を入れて無いと思う。


標準モジュール

Sub formshow()
UserForm1.Show
End Sub

Function Fold_Get() As String
Dim CrObj As Object, GetNam As Variant
Set CrObj = CreateObject("Shell.Application"). _
      BrowseForFolder(0, "フォルダを選択してください", 0)
If Not CrObj Is Nothing Then
  Fold_Get = CrObj.self.Path
End If
DoEvents
Set CrObj = Nothing
End Function


フォームモジュール

Private Sub CommandButton1_Click()
TextBox1.Value = Fold_Get
End Sub

Private Sub CommandButton2_Click()
Dim FNM As Object, FPas As String
If TextBox1.Value = "" Then Exit Sub
FPas = TextBox1.Value
ListBox1.Clear
For Each FNM In CreateObject("Scripting.FileSystemObject").GetFolder(FPas).Files
  If Right(Dir(FNM), 4) = ".jpg" Or Right(Dir(FNM), 4) = ".bmp" Or _
    Right(Dir(FNM), 4) = ".gif" Then
    ListBox1.AddItem Dir(FNM)
  End If
Next
End Sub

'画像クリア
Private Sub CommandButton3_Click()
Image1.Picture = Nothing
ListBox1.ListIndex = -1
End Sub
'全体
Private Sub CommandButton4_Click()
Dim IMHI As Double, IMWd As Double
With Image1
  .AutoSize = False
  .PictureSizeMode = 3
  .Height = Frame1.Height
  .Width = Frame1.Width
  IMHI = .Height
  IMWd = .Width
End With
With Frame1
  .ScrollHeight = IMHI
  .ScrollWidth = IMWd
  .ScrollTop = 0
  .ScrollLeft = 0
End With
End Sub
'標準
Private Sub CommandButton5_Click()
Image1.PictureSizeMode = 1
End Sub


Private Sub ListBox1_Click()
Dim Adst As String
Dim IMHI As Double, IMWd As Double
Adst = TextBox1.Value
If Len(Adst) = 0 Then Exit Sub
Adst = Adst & "\" & ListBox1.List(ListBox1.ListIndex)
With Image1
  .Picture = LoadPicture(Adst)
  .PictureSizeMode = 0
  .AutoSize = True
  .Left = 0
  .Top = 0
  IMHI = .Height
  IMWd = .Width
End With
With Frame1
  .ScrollHeight = IMHI
  .ScrollWidth = IMWd
  .ScrollTop = 0
  .ScrollLeft = 0
End With
End Sub


菅野美穂
テレビドラマで、陰険な役ばかり演じていたのを見てきたので、
そのまんまが印象が残っていて、

陰険な奴やな〜!
こいつダメ。

と、良い印象が残ってないのです。

【67207】Re:ブックのサイズを縮小する
お礼  Abebobo  - 10/11/15(月) 20:42 -

引用なし
パスワード
   Jaka さん ありがとうございます。
ためさせていただきます。
少し時間がかかるかもしれません

【67210】Re:ブックのサイズを縮小する
発言  kanabun  - 10/11/15(月) 22:31 -

引用なし
パスワード
   ▼Abebobo さん:
こんにちは〜〜

横道すみません
>古くからPCいじってる人は、縮専?というソフトで画像を圧縮してから
>エクセルに貼っています。最近始めた人が・・・

宣伝になっちゃうけど、ぼくの周囲では
NXPowerLite
ってのが頻繁に利用されてます。写真をぺたぺた貼りつけた
Bookのファイルサイズが(みごとに)縮小されます。画質は
見た感じでは劣化してません。
(ただ有償なのでおすすめはしませんけど、
20回くらい試用できますので、試されてみるのもよいかもです)
では。

【67211】Re:ブックのサイズを縮小する
お礼  Abebobo  - 10/11/15(月) 22:53 -

引用なし
パスワード
   kanabun さん こんばんは

情報ありがとうございます。

>NXPowerLite
魅力的なソフトですね。
実は、エクセルよりももっとたちの悪いのが、
パワーポイントのファイル!

>(ただ有償・・・
う〜ん・・・ 痛い

3ヶ月くらい前なら試用版を試したのに!
今は、PCに勝手にソフトを入れることができません。
コンプライアンス厳守の為だって

【67219】間違い修正
発言  Jaka  - 10/11/16(火) 9:29 -

引用なし
パスワード
   あ、間違えた。

>Frame1のプロパティ KeepScrolBarsVisible を3に設定。
              ↓
            ScrolBars です。

ついでに、イメージの外枠は無しで。
BorderStyle   0-fmBorderStyleNone

【67221】Re:ブックのサイズを縮小する
お礼  Abebobo  - 10/11/16(火) 10:00 -

引用なし
パスワード
   Jaka さん おはようございます。

確認しました。

今回質問させていただいた内容は、

今、サーバーにある、写真のせいで容量が大きいエクセルブックの容量を小さくしたい。  

でした。

でも、
『おお〜』って感じで感動しました。

ボタンで、写真の表示サイズが変わるとか、
特に、CommandButton2 のコードは今後の為になります。
ありがとうございます。

【67222】Re:間違い修正
発言  Abebobo  - 10/11/16(火) 10:03 -

引用なし
パスワード
   Jaka さん 入れ違った!

大丈夫でしたよ。この辺は好みの部分もあるんですよね

>あ、間違えた。
>
>>Frame1のプロパティ KeepScrolBarsVisible を3に設定。
>              ↓
>            ScrolBars です。
>
>ついでに、イメージの外枠は無しで。
>BorderStyle   0-fmBorderStyleNone

【67236】Re:ブックのサイズを縮小する
発言  ichinose  - 10/11/17(水) 7:11 -

引用なし
パスワード
   おはようございます。

>
>>For Each Shp In ActiveSheet.Pictures
>これ! If でタイプわけしなくて良くなりました。

私もPicturesコレクション、愛用していますが、先日別サイトで

www.excel.studio-kazu.jp/kw/20101109113323.html

ご覧のようなご指摘を受けました。

Pictursでは、ActiveXConrolが含まれてしまう事、長年使ってきましたが、
全く気づきませんでした。

よって、この事実を考えると

Picturesで回せば、色んな図形が存在する場合は、ループ回数は、減りそうなので

For Each ShP In .ActiveSheet.Pictures
  If ShP.shaperange.Type = 13 Then


Typeをチェックすることは、仕様によっては必要かもしれませんよ。

PictureやDrawingObjectsは、隠しオブジェクトですが、便利なところが
沢山あります。が、互換性とのからみで意外な事実も隠されていそうですよ。

昨日も今更ながら、気づいたのは、オーシェイプの殆どが
隠しオブジェクトのRectangleに属していること。
これは、考えてみれば 他に当てはめる箇所がないかア ということなんでしょうけど・・・。
スマイルもRectangleだと、ピンとはこないなあ・・・。

おじゃましました。

【67238】Re:ブックのサイズを縮小する
お礼  Abebobo  - 10/11/17(水) 9:48 -

引用なし
パスワード
   ichinose さん ありがとうございます。

これかなぁ〜?
あるブックでSelectできなくて止まっちゃいました。
nameも取れなくて何かわからずじまいした。

Pictures に すればグループ化された写真も処理、でもまれに止まる
Shapes  に すればグループ化された写真未処理。

どちらにしても、写真が2枚重なっている場合の順序とかもしっかりやらないと完全自動にはなりそうにありません。
と考えるとkanabunさんのご紹介ソフトがとても気になります。

【67246】Re:ブックのサイズを縮小する
発言  Jaka  - 10/11/17(水) 13:38 -

引用なし
パスワード
   ▼Abebobo さん:
>今回質問させていただいた内容は、
>
>今、サーバーにある、写真のせいで容量が大きいエクセルブックの容量を小さくしたい。  
>
>でした。
>
>でも、
>『おお〜』って感じで感動しました。

あれは、Abebobo さんが落とした秘密の画像をこっそり見るためのもので、
普通に開くとドバッと大きく表示されちゃうじゃないですか、
それを防ぐのに
>150x150ぐらいでいいんじゃないかと
と表示面積を小さくして、スクロールして中身を確認できるようにと。

【67257】Re:ブックのサイズを縮小する
お礼  Abebobo  - 10/11/17(水) 18:17 -

引用なし
パスワード
   Jaka さん
そうでしたか〜。

確か、コマンドボタン3を押すと全体表示に切り替わるようになっていましたよね。
写真のサイズによっては虫眼鏡で見てるような感じで、興奮するかも(笑)

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