Excel VBA質問箱 IV

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

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


38 / 13006 ツリー ←次へ | 前へ→

【79005】エクセルへの写真画像の貼り付け ひでとし 17/4/10(月) 21:34 質問[未読]
【79016】Re:エクセルへの写真画像の貼り付け ひでとし 17/4/14(金) 20:43 発言[未読]
【79018】Re:エクセルへの写真画像の貼り付け β 17/4/14(金) 20:57 発言[未読]
【79019】Re:エクセルへの写真画像の貼り付け γ 17/4/14(金) 23:18 発言[未読]
【79020】Re:エクセルへの写真画像の貼り付け ひでとし 17/4/15(土) 3:43 質問[未読]
【79021】Re:エクセルへの写真画像の貼り付け β 17/4/15(土) 8:55 発言[未読]
【79022】Re:エクセルへの写真画像の貼り付け ひでとし 17/4/15(土) 9:58 回答[未読]

【79005】エクセルへの写真画像の貼り付け
質問  ひでとし E-MAIL  - 17/4/10(月) 21:34 -

引用なし
パスワード
   エクセルのセルでダブルクリックすると、画像を選び、セルにぴったり収まるように一番大きく貼り付けます。デジカメで撮った画像は、ぴったりに収まりません。やや小さくなります。オリジナル画像をペイントで呼び出してそのまま上書き保存をすると、今度はその画像はぴったり収まります。VBAに問題があるのか教えて下さい。

VBA
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
                    Cancel As Boolean)
  Dim PicFile As Variant
  Dim rX As Double, rY As Double

  '[ファイルを開く]ダイアログボックスを表示
    PicFile = Application.GetOpenFilename( _
            "画像ファイル,*.jpg;*.jpeg;*.gif;*.tif;*.png;*.bmp")
  If VarType(PicFile) = vbBoolean Then Cancel = True: Exit Sub


  Application.ScreenUpdating = False
  
  '画像を挿入
  With ActiveSheet.Pictures.Insert(PicFile)
    rX = Target.Height / Target.Width
    rY = .Height / .Width
    If rX > rY Then
        .Width = Target.Width
    Else
       .Height = Target.Height
    End If

  'セルの中央(横方向/縦方向の中央)に配置
    .Left = Target.Left + (Target.Width - .Width) / 2
    .Top = Target.Top + (Target.Height - .Height) / 2
  End With
  
  Application.ScreenUpdating = True
  Cancel = True
End Sub

【79016】Re:エクセルへの写真画像の貼り付け
発言  ひでとし E-MAIL  - 17/4/14(金) 20:43 -

引用なし
パスワード
   回答が一つもつきませんが、質問の仕方が悪かったでしょうか。ご指摘ください。よろしくお願いします。

【79018】Re:エクセルへの写真画像の貼り付け
発言  β  - 17/4/14(金) 20:57 -

引用なし
パスワード
   ▼ひでとし さん:

おそらく、閲覧した側で実際にやってみて、そういった事象にならない、
再現ができない なので、回答ができないといううことではないでしょうか。
(私も、あれこれやってみましたが、再現しません)

考えられるとすれば、そのままの写真というものが わくの部分が背景色透明で
目に見えない形で存在。
ペインと等で開いて別名で保存したものは、その枠の部分がなくなった形になっている。

でも、そういうことは、あくまで想像ですし、こちらからは見えませんので。

マクロから離れて、また拡大・縮小も忘れて、単純に その 2つの画像ファイルを
シートに貼り付けたときに、
それぞれを選択して表示されるシェープとしての外枠、全くおなじでしょうか?

一方は写真の中身にそった外枠、一方はそれより一回り大きめの外枠になっている
ということはありませんか?

【79019】Re:エクセルへの写真画像の貼り付け
発言  γ  - 17/4/14(金) 23:18 -

引用なし
パスワード
   私は"デジカメで撮った画像"というものが手元にないので、
何事かを申し上げる材料がありません。

> VBAに問題があるのか教えて下さい。
もちろん自分の手元にある画像で実行してみていました。
たぶんそれ自体には問題がないだろうとは想像しましたが、
絶対に問題がないと保証できる根拠もありませんし、
リスクをこちらが取って保証しなきゃいけない義理もなにも
ないですわね。

ステップ実行して、自分の想定とどの段階で異なるか調べるのは
それは質問者さんの仕事でしょう。

・オリジナル画像をペイントで呼び出してそのまま上書き保存したものと
・オリジナルとで
ファイルとしてどう違うのか(サイズ、画像形式、カラー(色じゃないほう)とか、枠とか)
調べてみてはどうでしょうか。

【79020】Re:エクセルへの写真画像の貼り付け
質問  ひでとし E-MAIL  - 17/4/15(土) 3:43 -

引用なし
パスワード
   返信を有り難うございました。
昨年までは、職場のvistaのパソコンで AddPicture を使ったVBAで画像とりこみをしていました。ところが今年になって職場のパソコンが変わり、使えなくなりました。win10 64bitではAddPictureが使えないようです。そこで今回投稿したVBAにしました。Pictures.Insertは使えるようです。ところが、今回の現象です。わかったことは、カメラを縦にしてwin10で取り込んだ画像について起こります。win7やvistaでは、問題ありませんでした。また、何かのソフトで画像を保存し直すとうまくいきます。win10は、画像の縦横問題があるようですが、よくわかりませんでした。
何かわかれば教えていただきたいです。ただ、VBAの問題ではないような気もしますので回答がなければ何日かしてこの投稿を削除させていただきたいと思います。有り難うございました。

【79021】Re:エクセルへの写真画像の貼り付け
発言  β  - 17/4/15(土) 8:55 -

引用なし
パスワード
   ▼ひでとし さん:

いくつかコメントしておきます。

>win10 64bitではAddPictureが使えないようです。

そうなんですか?
当方 win7+xl2010、win10+xl2013 いずれでも、問題なく AddPicture は使えます。
もっとも win はいずれも64Bit ですが、エクセルは いずれも 32Bitです。

>win10は、画像の縦横問題があるようですが

デジカメでカメラを縦にして撮ったものでしたか。
スマホでは、PCに取り込んだ際に、それなりに(?)縦なら縦の状態で
取り込まれるようですが、デジカメの場合はあくまで横にひっくり返った状態で
取り込まれるようで、それを画像ソフトで回転させて、保存しなおしたりしますけど
そういう操作をされたんでしょうか?
詳しくないですが、回転させたとしたら、その際に、なんらかの補正が行われている可能でいもありますね。

vista でどうなるか、環境がないのでわかりません。

>回答がなければ何日かしてこの投稿を削除させていただきたいと思います。

レスが付いたトピは、もう ひでとしさんの所有物ではなく掲示板全体の
共有物ですから削除は具合悪いでしょ。
(やったことはないですが、質問箱の機能としても、それはできないのでは)

解決ではないですが、トピを閉じる というコメントをアップされたらよろしいのでは?

【79022】Re:エクセルへの写真画像の貼り付け
回答  ひでとし E-MAIL  - 17/4/15(土) 9:58 -

引用なし
パスワード
   たびたびの回答を有り難うございます。

いくつか説明不足でした。職場のパソコンは富士通製のノートパソコンでwin10 64bit Office Professional Plus 2016 64bit が組み込まれた状態で従業員全員に1台ずつ与えられています。その環境ですとAddPictureの命令がうまく機能してくれません。下記のマクロです。自宅は、win10 32bit office2016 32bitで動きますが、最初の投稿と同様で画像が少し小さく取り込まれてしまいます。

Private Sub worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim fd As FileDialog
Dim Shp As Shape
Dim cell_r As Double, gazou_r As Double

Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Filters.Clear
fd.Filters.Add "画像ファイル", "*.bmp; *.gif; *.jpg; *.jpeg; *.png", 1
If fd.Show Then
   Set Shp = Me.Shapes.AddPicture(fd.SelectedItems(1), _
           msoFalse, msoTrue, Target.Left, Target.Top, 1, 1)
  
   Shp.ScaleHeight 1, msoTrue
   Shp.ScaleWidth 1, msoTrue
   Shp.LockAspectRatio = msoTrue
   With Shp
     cell_r = Target.Height / Target.Width
    gazou_r = .Height / .Width
    
    If cell_r < gazou_r Then
      .Height = Target.Height
    Else
      .Width = Target.Width
    End If

    'セルの中央(横方向/縦方向の中央)に配置
    .Left = Target.Left + (Target.Width - .Width) / 2
    .Top = Target.Top + (Target.Height - .Height) / 2
  
   End With
End If
  Set fd = Nothing
  Cancel = True

End Sub

取り込む画像は、ほとんどが顔写真です。したがってデジカメを縦にして写真を撮りそのファイルをそのままパソコンに取り込んでいます。(ソフトは使わずに直接SDカードからコピー)また、回転等はしていません。

削除については、ルールがわかっていませんでした。申し訳ありませんでした。

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