Shape画像保存モードの事後変更
- VBA Excel2007を使用しています。画像を読み込むために、一旦、画像を「文書とともに保存しない」モードで読み込み、後にそのShape画像を「文書とともに保存する」ように変更することは可能でしょうか。
- VBA Excel2007で画像を読み込む方法について質問です。一度画像を「文書とともに保存しない」モードで読み込み、その後にShape画像を「文書とともに保存する」ように変更することはできますか。
- VBA Excel2007の画像読み込みに関して質問です。一旦画像を「文書とともに保存しない」モードで読み込み、後からそのShape画像を「文書とともに保存する」ように変更することは可能でしょうか。
- ベストアンサー
Shape画像保存モードの事後変更
VBA Excel２００７を使用しています。 画像を読み込むために、例えば、 Dim picture As Shape Set picture = ActiveSheet.Shapes.AddPicture(filename:=filename, LinkToFile:=msoTrue, SaveWithDocument:=msoFalse, Left:=Selection.Left, Top:=Selection.Top, Width:=0, Height:=0) のように、一旦、画像を「文書とともに保存しない」モードで読込み、後にそのShape画像を「文書とともに保存する」ように変更することは、可能でしょうか。
- softwarelearner
- お礼率100% (20/20)
- Visual Basic
- 回答数3
- ありがとう数3
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
#1です。Width:=0, Height:=0のため、サイズの無い画像がコピペされているのでは？ 下記では如何でしょうか。 Sub test() Dim myPicture As Shape Dim myfileName As String myfileName = "C:\Users\????\Desktop\hoge.jpg" Set myPicture = ActiveSheet.Shapes.AddPicture(fileName:=myfileName, LinkToFile:=msoTrue, SaveWithDocument:=msoFalse, Left:=Selection.Left, Top:=Selection.Top, Width:=0, Height:=0) With myPicture .ScaleHeight 1, msoTrue, msoScaleFromTopLeft .ScaleWidth 1, msoTrue, msoScaleFromTopLeft .Cut End With ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False End Sub
その他の回答 (2)
- mitarashi
- ベストアンサー率59% (574/965)
#2です。 >ファイル名中にスペースがある画像を取り込めず 僅かばかりの試験ではありますが、当方の環境(Windows7Home-64bit, xl2010-32bit）では再現されませんでしたのでお知らせします。
お礼
有難うございます。 この問題には、画像ファイルを一旦スペースを含まないファイルにコピーしてから取り込むという手段でなんとか対処し、表面上は問題なくなりました。 ちなみに、こちらの環境はWindows7Home-64bit, xl2007-32bitです。
- mitarashi
- ベストアンサー率59% (574/965)
1.安直には、クリップボードにコピーして貼り付け戻す。 リンク先の下の方にも記載があります。 http://www.moug.net/tech/exvba/0120020.html 2.xmlを書き換え、画像を組み込む アイデアだけで、実現する元気は無いです。 http://okwave.jp/qa/q7320070.html もっとスマートな方法があるかは分かりません。 以上、ご参考まで。
お礼
有難うございます。 とりあえず、安直な方法を試してみました。 しかし、確かに、 ActiveSheet.Pictures.Insert(Filename:=filename) に対しては、うまく働きましたが、 Set picture = ActiveSheet.Shapes.AddPicture(filename:=filename, LinkToFile:=msoTrue, SaveWithDocument:=msoFalse, Left:=Selection.Left, Top:=Selection.Top, Width:=0, Height:=0) に対しては、うまくいきませんでした。ActiveSheet.PicturesとActiveSheet.Shapesの違いによるものでしょうか？
関連するQ&A
- Excelでセル上の画像を別のセルにコピーするには
いつも楽しく勉強させていただいております。 つぎのような処理をしたいのですが、うまくいきません。 １．セル１の上にある画像をセル２の上にコピーする。 ２．コピーした画像をセル２の高さと幅にフィットさせる。 まず、このようなマクロを考えてみました。 Range("A1").CopyPicture Range("C1").Select ActiveSheet.Paste ActiveSheet.Shapes(Selection.Name).LockAspectRatio = msoFalse ActiveSheet.Shapes(Selection.Name).Top = Range("C1").Top ActiveSheet.Shapes(Selection.Name).Left = Range("C1").Left ActiveSheet.Shapes(Selection.Name).Height = Range("C1").Height ActiveSheet.Shapes(Selection.Name).Width = Range("C1").Width これですと元の画像がA1のセルより小さい場合、周囲に余白がある形でコピーされてしまいます。 C1にコピーしたら余白はなしでC1の大きさいっぱいに画像を引き延ばしたい（あるいは縮小したい）のです。 そこで次のように変更してみました。 （上のプログラムと一番上の行のみが違います）。 ActiveSheet.Shapes("図 6").Copy Range("C1").Select ActiveSheet.Paste ActiveSheet.Shapes(Selection.Name).LockAspectRatio = msoFalse ActiveSheet.Shapes(Selection.Name).Top = Range("C1").Top ActiveSheet.Shapes(Selection.Name).Left = Range("C1").Left ActiveSheet.Shapes(Selection.Name).Height = Range("C1").Height ActiveSheet.Shapes(Selection.Name).Width = Range("C1").Width これもうまくいきません。 A1にある元の"図 6"は動かしたくないのに、勝手にB1の位置に移動してしまいます。 というのは、"図 6"という画像をコピーすると、同じ名前で画像ができちゃうんですね。 コピー元とコピー先の両方の画像に対して位置や高さを設定することになるようです。 ということで、 １．セル１の上にある画像をセル２の上にコピーする。 ２．コピーした画像をセル２の高さと幅にフィットさせる。 これを実現させるにはどうしたらいいでしょう。
- ベストアンサー
- その他MS Office製品
- エクセルでリンクされたイメージが表示できません
エクセルでリンクされたイメージが表示できませんとたまに表示されます。 この理由はどうしてですか？ 画像は下記のＶＢＡを用いてセルＣ１１３に貼っています。 Sub 貼付() ActiveWindow.View = xlNormalView Range("C113").Select myFileName = "C:\凡例.bmp" '---挿入する画像ファイルの指定 'Cells(113, 3).Select 'ActiveSheet.Pictures.Insert Filename:=myFileName '---選択位置に画像を挿入 Set myShape = ActiveSheet.Shapes.AddPicture(Filename:=myFileName, _ LinkToFile:=True, SaveWithDocument:=False, Left:=Selection.Left + 50, _ Top:=Selection.Top, Width:=200#, Height:=100#) end sub
- ベストアンサー
- Visual Basic
- PowerPointのVBAで、図形を縮小後、画質を落とさずに出力する方法
PowerPointのVBAで、スライド上の図形のサイズを縮小した後、この図形をjpg画像として保存したいです。 オペレーションはこんな感じです↓ 図形縮小→図形を選択→右クリック→[図として保存]→JPGファイル名で保存 上記操作を「マクロの記録」で記録したものを実行すると、スライド全体が保存されてしまいます。 また、マクロで.ShapeRange.Exportで画像出力すると、画質が荒くなって出力されます。 画質を落とさず、図形をjpgとして保存する方法はないでしょうか。 よろしくお願い致します。 以下が、現状の私のプログラムです。 Sub Macro() ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="C:\aaaa.JPG", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=-119, Top:=-89, Width:=960, Height:=720).Select ActiveWindow.LargeScroll ToRight:=1 With ActiveWindow.Selection.ShapeRange .ScaleWidth 0.25, msoFalse, msoScaleFromTopLeft .ScaleHeight 0.25, msoFalse, msoScaleFromTopLeft End With With ActiveWindow.Selection.ShapeRange .IncrementLeft 219.12 .IncrementTop 416.75 End With ActiveWindow.Selection.ShapeRange.Select 'これだと画質が落ちます。↓ Call ActiveWindow.Selection.ShapeRange.Export("C:\\bbb.jpg", ppSaveAsJPG) 'これだとスライド全体が保存されます。↓ ' ActivePresentation.SaveAs FileName:="C:\bbb.jpg", FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse End Sub
- ベストアンサー
- オフィス系ソフト
- 選択したセルにピッタリ合うオートシェイプの挿入
よろしくお願いいたします。 下記のコードは行方向では選択したセルとピッタリに四角のオートシェイプが挿入できるのですが、列方向では常に１行です。 横方向も選んだ範囲だけ広がるようにするにはどう変えたらよいでしょうか。 Set shrect = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ Selection.Left, Selection.Top, Selection.Offset(0, 1).Left - Selection.Left, _ Selection.Height)
- ベストアンサー
- Visual Basic
- VBAで画像を自動で切り替える方法
Ｅｘｃｅｌで棚割表を作っています。商品コードを打つとその商品の画像を自動で表示させたいのですが、雑誌を見ながらコードをアレンジしてほぼ完成したのですが、「プロシージャーが大きい」とエラーが出てマクロを実行出来ません。 画像は100個程度あり、先に別のマクロで貼り付けてあります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ファイル As String If Intersect(Target, Range("A4")) Is Nothing Then ActiveSheet.Shapes("画像").Delete ファイル = "C:\保存場所\" & Range("A4").Value & ".jpg" Range("B5").Select ActiveSheet.Pictures.Insert(ファイル).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Top = ActiveCell.Top Selection.ShapeRange.Left = ActiveCell.Left Selection.ShapeRange.Height = 97 Selection.ShapeRange.Width = 52.5 Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.IncrementLeft 1.5 Selection.ShapeRange.IncrementTop 1.5 Selection.Name = "画像" End If （中略） Dim ファイル98 As String If Intersect(Target, Range("U60")) Is Nothing Then Exit Sub ActiveSheet.Shapes("画像98").Delete ファイル98 = "C:\保存場所\" & Range("U60").Value & ".jpg" Range("V61").Select ActiveSheet.Pictures.Insert(ファイル98).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Top = ActiveCell.Top Selection.ShapeRange.Left = ActiveCell.Left Selection.ShapeRange.Height = 97 Selection.ShapeRange.Width = 52.5 Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.IncrementLeft 1.5 Selection.ShapeRange.IncrementTop 1.5 Selection.Name = "画像98" End Sub 省ける箇所や分割する方法などありましたら教えてください。
- ベストアンサー
- オフィス系ソフト
- Excel VBA シェイプの原型のサイズ取得方法
VBAでシェイプの縦横比を%指定で変更したく、下記のように書いています ActiveSheet.Shapes("Picture 208").Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.ScaleWidth 2, msoFalse '横2倍の大きさに ところが、ScaleWidthが見ている数値が元の図形のものと違うようです。原因を探すためにシェイプの原型のサイズ(幅や高さの数値)を知りたいのですが、VBAからアクセスできるプロパティやメソッドはあるでしょうか?
- ベストアンサー
- その他（プログラミング・開発）
- VB6 エクセルに画像貼り付け
お世話になります。 ＶＢ６でエクセルのセルを数値で指定して、そこに画像を読み込んで実態を張り付けたいのですが、 色々調べて ActiveSheet.Pictures.Insertと ActiveSheet.Shapes.AddPictureを試してみましたが ActiveSheet.Shapes.AddPicture( FileNameTmp, False, True, 10, 20, 0, 0) AddPictureはもしかしてVB6には対応していないのでしょうか？ 構文エラーになってしまいます。 ActiveSheet.Pictures.Insert(FileNameTmp).Select Insertだと画像がリンクになってしまいます。
- ベストアンサー
- Visual Basic
- ワードでマクロで画像を中央揃えにしたい
ワードでマクロを使って、挿入・画像ファイルで取り込んだ画像を、レイアウトの詳細設定で水平、垂直ともページを基準にして、中央揃えにしたいのです。 画像は１ページに１枚です。 たくさんの画像を一つ一つやるのは大変です。 やり方のわかる方がいたらお願いします。 参考までに画像を取り込む部分を載せておきます。 ' Sub Macro1() ' Dim FileName As String ' ChDir ThisDocument.Path ' FileName = Dir("*.jpg") While FileName > "" Selection.InsertBreak Type:=wdPageBreak ' 改ページ Application.Browser.Previous ' 前のページへ ' 画像の読み取り ActiveDocument.Shapes.AddPicture(Anchor:=Selection.Range, _ FileName:=FileName, LinkToFile:=False, _ SaveWithDocument:=True).WrapFormat.Type = 5 ' Application.Browser.Next ' 次のページへ ' FileName = Dir Wend ' End Sub '
- 締切済み
- Visual Basic
- Windows Server 2003 IIS環境で外部の画像ファイルを取得したい
外部のサーバーにある画像ファイルをエクセルに表示するというプログラムをC#で組んでいます。 ローカルでは問題なく動くのですが、サーバーだと画像を貼り付ける処理のところでとまってしまいます。 【環境】 Windows Server 2003 IISインストール済み 言語：C# Apache2.2 【ソース】 Excel.Shapes shapes = Sheet1.Shapes; Excel.Shape shape = shapes.AddPicture( URL, Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoTrue, x, y, w, h); ローカルにおいた画像を貼り付けることはできたので、権限の問題かと思いますが。。。。 何卒宜しくお願いします。
- 締切済み
- Windows系OS
- エクセルVBA オートシェイプを操作したいです
エクセルでセルの入力内容によって楕円をオートシェイプで出現させたいと思います。 http://oshiete1.goo.ne.jp/qa809742.htmlで見つかったものを参考にし、 Private Sub worksheet_Activate() Dim Shp As Shape Set P11 = Range("P11") If P11 Is Nothing Then Exit Sub If P11.Value = 1 Then For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N14:N15")) Is Nothing Then Shp.Delete End If Next Shp With ActiveSheet.Range("N14:N15") ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _ Left:=.Left,TOP:=.TOP,Width:=.Width,Height:=.Height).Select Selection.ShapeRange.Fill.Visible = msoFalse End With Range("N14").Select Else For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N14:N15")) Is Nothing Then Shp.Delete End If Next Shp End If If P11.Value = 2 Then For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N16")) Is Nothing Then Shp.Delete End If Next Shp With ActiveSheet.Range("N16") ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _ Left:=.Left, TOP:=.TOP, Width:=.Width, Height:=.Height).Select Selection.ShapeRange.Fill.Visible = msoFalse End With Range("N16").Select Else For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N16")) Is Nothing Then Shp.Delete End If Next Shp End If End Sub とつなげて見ました。 動くには動くのですが、データ元のセルがP11からT30と100セルあり、さらにP11に入力されるデータが１，２，３，４の4種類、AQ11に５，６，７，８，９の5種類などと、ばらばらです。 P11に１が入力されるとN14:N15(結合されています)に円が入り、２が入力されるとN16に円が入る。 Q11に５が入力されるとR13に円が入り、６が入力されるとR14:R15に円が入る・・・・のようにしたいのです。 一生懸命、セルNo.を打ち込んでいたら、 「コンパイルエラー：プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。
- ベストアンサー
- その他MS Office製品
お礼
有難うございます。 ご指摘のとおりで、サイズを設定したら上手くいきました。 ついで質問で、申し訳ないのですが、もうひとつ疑問があります。 Set myPicture = ActiveSheet.Shapes.AddPicture(fileName:=myfileName, LinkToFile:=msoTrue, SaveWithDocument:=msoFalse, Left:=Selection.Left, Top:=Selection.Top, Width:=0, Height:=0) において、 LinkToFile:=msoFalse, SaveWithDocument:=msoTrue にした場合と比較すると、前者では、ファイル名中にスペースがある画像を取り込めず、後者では取り込めるという違いが起こりました。これは、どういう理由によるものでしょうか。前者、つまり今使っているもの、でも、スペースの入ったファイル名の画像を取り込むにはどのようにすればよいでしょうか。 お分かりでしたら、宜しくお願いします。 お世話になります。