• 締切済み

写真を縦に取り込むには？

質問１ 写真を縦に取り込むには以下マクロをどのように変えたらよいのか？ を教えてください。 質問２ ＪＰＧとｊｐｇを取り込むにはどうしたらよいのでしょうか？ Sub test01() ListUp_FileList ("C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures") End Sub Sub ListUp_FileList(FolderSpec) Dim File_Collection As Object Dim File_List As Variant Dim cnt As Integer Set File_Collection = CreateObject("Scripting.FileSystemObject") _ .GetFolder(FolderSpec).Files cnt = 1 l = 10 For Each File_List In File_Collection If Right(File_List, 4) = ".jpg" Then 'Range("A" & Format(cnt)) = File_List.Name ActiveSheet.Pictures.Insert(FolderSpec & "\" & File_List.Name).Select Selection.ShapeRange.Left = l + (cnt - 1) * 150 Selection.ShapeRange.Width = 130 Selection.ShapeRange.Height = 104 Selection.ShapeRange.Top = 360 cnt = cnt + 1 End If Next End Sub

みんなの回答

  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.3

> 写真を回転させて縦にしたいのではなく、写真を縦に配列させたいのです。 失礼しました。既に的確なご回答がありますが、参考まで。 ■ 1. について #2 ご回答のとおりだと思います。 ■ 2. について VB(A) は文字列比較において「大文字・小文字」を原則的に区別します。 2. のポイントは「大文字・小文字」を区別しないで文字列を比較する方法 ということになります。 これも #2 ご回答のとおりですが、補足します。 方法１）UCase（または LCase）で大文字（または小文字）に統一して比較する 　　If Ucase(Right(File_List, 4)) = ".JPG" Then 方法２）StrConv で大文字（または小文字）に統一して比較する 　　If StrConv(Right(File_List, 4), vbLowerCase) = ".jpg" Then 方法３）StrComp のテキスト比較モード（vbTextCompare)で比較する 　　If StrComp(Right(File_List, 4), ".jpg", vbTextCompare) = 0 Then 方法４）モジュールの先頭に Option Compare Text を書く 上記の関数の使い方や詳しい意味はヘルプなり、WEB 検索で調べて下さい。

yamada_tarou
質問者

お礼

回答有り難うございました。 問題は解決できました。 本当に有り難うございました。

  • marbin
  • ベストアンサー率27% (636/2290)
回答No.2

1.への回答 Left と Top の意味を理解してください。 理解できれば、自ずとどこをどのように書き換えればいいか 分かると思います。 2.への回答 UCase を使ってはいかがでしょう？

yamada_tarou
質問者

お礼

回答有り難うございました。 うーん、理解はできてないけど、色々とかえてみたら何とかできました。何となくですが、LeftとTopの意味がわかったような感じです。 どうも有り難うございました。

  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.1

写真を90度回転させる記録マクロがヒントになりますが... むしろ、Photo Editor とか、フリーツールで画像自体を回転 など編集しておいてから、Excel に取り込んだ方が良いのでは？

yamada_tarou
質問者

補足

回答有り難うございます。 えーっと、写真を回転させて縦にしたいのではなく、写真を縦に配列させたいのです。現状では、横に配列されてしまいます。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • Excel２００３で動いたVisualが２００７では？

    Excel２００３で作った下記のVisual　Basicが２００７では、最初にクリックしたところには行かず いつも同じ位置に挿入されます。 出来ればセルF1の位置に挿入したいのですが Sub macro1() Dim Fname As String Dim FLT As String Dim Sheetmei As String FLT = "JPEGファイル(*.jpg),*.jpg" Fname = Application.GetOpenFilename(FLT, 2, "開く", True) If Fname = "False" Then Exit Sub End If Sheetmei = Worksheets(1).Name ActiveSheet.Pictures.Insert(Fname).Select Call Jpeg_size_adjust End Sub サブで下記も有ります Sub Jpeg_size_adjust() Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = 270.75 Selection.ShapeRange.Width = 360

  • 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 省ける箇所や分割する方法などありましたら教えてください。

  • 画像をアクティブセルの左上隅に配置し任意のセルに

    画像をアクティブセルの左上隅に配置し任意のセルにその画像ファイル名を自動で入力したいです やりたいことは以下になります 例えば画像をアクティブセル（D2）の左上隅に貼り付けて 貼り付けた画像のファイル名をC2に自動で入力をしたいです ファイル名に関しては拡張子も明記するコードとしないコード二つご教授して頂けると大変嬉しいです 下記のコード二つを組み合わせればできそうなんですが どのようにしたらいいのか分かりません よろしくお願いします Sub 図形挿入() Dim FilePath As Variant FilePath = Application.GetOpenFilename(",*.png") If Not FilePath = False Then ActiveSheet.Pictures.Insert(FilePath).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Width = Selection.ShapeRange.Width * 1# Selection.ShapeRange.Left = ActiveCell.Left + 2.25 Selection.ShapeRange.Top = ActiveCell.Top + 2.25 With Selection.ShapeRange.Line .Weight = 2.25 '線の太さを2.25に .ForeColor.RGB = RGB(255, 0, 0) '赤枠に End With End If End Sub Sub ファイル名をセルに入力() Dim OpenFileName As String Dim tmp As Variant OpenFileName = Application.GetOpenFilename(FileFilter:="画像 ,*.png; *.jpg; *.gif; *.bmp", Title:="ファイルの選択") If OpenFileName <> "False" Then tmp = Split(OpenFileName, "\") Range("C2").Value = tmp(UBound(tmp)) End If End Sub

  • エクセルマクロ　画像を所定の位置に貼り付けるには？

    エクセル上でボタンを押すと写真データーを所定の位置に貼り付ける 書式（excel2003で作成）を使っています。 exｃel2010になってから、皆さんが質問されているようにリンク張付になってしまい 保存していた書類から写真が消えてしまいました。 今は作成したらPDFで保存していますが、修正ができません。 そこで、ネットでいろいろ検索して、マクロをいじっているのですが、 コピー→削除→ペースト（セルの位置）まではなんとかできたのですが 指定した位置に貼り付ける方法が分かりません。 よろしくお願いします。 修正中のマクロが下記です。 Sub select_pic() Dim tt, ttl, Item As String Dim FileNamePath As Variant 'ファイルのパスを取得します tt = "写真 ファイル (*.jpg),*.jpg" ttl = "写真ファイルを選択してください" FileNamePath = SelectFileNamePath(tt, ttl) If FileNamePath = False Then 'キャンセルボタンが押された 　End End If ActiveSheet.Pictures.Insert(FileNamePath).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Width = 263 Selection.ShapeRange.Left = 12 Selection.ShapeRange.Top = 45 Selection.CopyPicture Selection.Delete ActiveSheet.Paste End Sub 　最後のPasteの前後に座標を入れればいいのだと思いますが エラーが出てだめです。分かる人にとっては簡単なのでしょうが よろしくお願いします。

  • Excel2007　VBAで画像挿入について

    Sub 図形挿入等倍() Dim FilePath As Variant FilePath = Application.GetOpenFilename(",*.png") If Not FilePath = False Then ActiveSheet.Pictures.Insert(FilePath).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Width = Selection.ShapeRange.Width * 1# Selection.ShapeRange.Left = ActiveCell.Left + 2.25 Selection.ShapeRange.Top = ActiveCell.Top + 2.25 End If With Selection.ShapeRange.Line .Weight = 2.25 '線の太さを2.25に .ForeColor.RGB = RGB(255, 0, 0) '赤枠に End With End Sub 上記のコードを書き、画像を挿入したときは問題ないのですが 画像を挿入せずにキャンセルすると 実行時エラー438 オブジェクトは、このプロパティまたはメソッドをサポートしていません。とでてしまいます デバックをしてみると With Selection.ShapeRange.Lineの部分が黄色くなっているので ここを修正したらいいと思うのですが どのように修正したらいいのか分かりません お分かりの方いましたらご教授お願い致します

  • 画像ファイルを保存する方法

    洗濯してる画像を保存するvbaコードが知りたいのですが Sub Sample() Dim PicFile As String Dim myRess As Variant PicFile = "C:\Users\test.jpg" ActiveSheet.Pictures.Insert PicFile ActiveSheet.Pictures.Insert(PicFile).Select PicFile = Selection.Name myRess = ActiveSheet.Shapes(PicFile).Picture.Export( _ ThisWorkbook.Path & "\test.jpg", "JPG", False) End Sub だと実行時エラー438になります。 Export メソッドは、グラフにしか使えないのでしょうか？ 画像ファイルを保存する方法をご教授ください。

  • エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、

    エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、 分からない部分があって困ってます。 (1)挿入したいセルにカーソルを合わせる (2)マクロ 　挿入－図－ファイル－図の挿入－図の書式設定－サイズ－30％ この作業を覚えさせると以下になりました。 Sub Macro3() ActiveSheet.Pictures.Insert("C:\Documents and Settings\デスクトップ\1.JPG") _ .Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 360# Selection.ShapeRange.Width = 480# Selection.ShapeRange.Rotation = 0# End Sub これだと、写真が指定されてしまいます。 マクロの途中で止まって任意の写真を都度選べるようにできますか？ 膨大な量の写真をセルに並べていきたいのです。

  • 　エクセルに写真を挿入するマクロを組んでいます。

    　エクセルに写真を挿入するマクロを組んでいます。 ２００３までは問題なく動作していたマクロが、 ２００７では位置調整がうまく行きません。 　そこでネットで検索して With Selection .Left = Range("C6").Left .Top = Range("C" & rowa).Top End With のように　Selection.Left　を使えば解決するとありましたが、 (1)ＷＩＮ　ＶＩＳＴＡのエクセル２００７では おなじひとつのエクセルファイルの あるシートではコード通りが位置でるのに 違うシートでは縦位置がずれる。 (2)ＷＩＮ　ＸＰのエクセル２００７では すべてのシートで縦位置がずれる。 ただし、ずれの位置は(1)よりは少ない。 といずれのＯＳでも不具合が出ます。 　事情によりエクセル２００７でこのマクロを使用しなければならなくなり 非常に困っております。 どなたか解決方法をご存知の方、よろしくお願いします。 　なお、(2)のＷＩＮ　ＸＰでは、エクセル２００３も入っており、 その中では、全く問題なくマクロが動作しています。 実際のコードは下の通りです。 Sub 写真呼出(koumoku, jpgf, tr As Variant) Dim rowa As String ActiveWindow.ScrollColumn = 1 ActiveWindow.ScrollRow = tr　←選択したセルの行ナンバー ActiveSheet.Pictures.Insert(motopath & "写真\" & koumoku & "\" & jpgf & ".JPG").Select Selection.Name = "写真" Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比の固定 Selection.ShapeRange.Height = 480 'Selection.ShapeRange.IncrementLeft 100　←不具合が出たので止めた部分 'Selection.ShapeRange.IncrementTop 40　　←不具合が出たので止めた部分 rowa = tr + 2 With Selection .Left = Range("C6").Left .Top = Range("C" & rowa).Top End With End Sub

  • VBAのGroup化について

    お世話になります。以下のマクロがうまく動きません。 ------------------------------------------------- Dim objShp1 As Shape For Each objShp1 In ActiveSheet.Shapes If objShp1.Name = "Picture 3" Then ActiveSheet.Shapes.Range(Array("A", "B", "Picture 3")).Select Selection.ShapeRange.Group.Select Selection.ShapeRange.ThreeD.RotationX = -180 Selection.ShapeRange.IncrementLeft 0 Selection.ShapeRange.IncrementTop 0 Else ActiveSheet.Shapes.Range(Array("A", "B")).Select Selection.ShapeRange.Group.Select <---------(1) Selection.ShapeRange.ThreeD.RotationX = -180 Selection.ShapeRange.IncrementLeft 0 Selection.ShapeRange.IncrementTop 0 End If Next ------------------------------------------------- このマクロは全体の一部分になりますが、（１）のところでエラーになります。 どこが間違っているのか、さっぱりわかりません。 すみませんが、お助けいただければ幸いです。

  • エクセル　マクロ　picture

    教えてもらいながら以下のような画像貼り付けマクロを組んだのですが，以下の点に引っかかり前進することができません． 教えて頂きたいと思い投稿しました． 躓いている点 　シート内でボタンを利用して貼り付け及び削除をしているのですが，エクセルシート内でコピペするたびに「Selection.Name」と貼り付け先を修正しています． →これをコピペしても修正をしなくてもよいマクロはないでしょうか？ 自作作成マクロ Sub 写真貼付1_Click() Dim AA As String, BB As String, CC As String 10 AA = InputBox("参照先を指定して下さい。例:D:\Photo001.jpg", "場所指定", AA) If (AA = "") Then AA = Application.GetOpenFilename(Title:="写真ファイルの場所はどこですか？") GoTo 10 End If ActiveSheet.Unprotect Range("m29").Select ActiveSheet.Pictures.Insert(AA).Select Selection.Name = "写真1" Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 310 Selection.ShapeRange.Width = 310# Selection.ShapeRange.IncrementLeft 1 Selection.ShapeRange.IncrementTop 1 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True End Sub -------------------------------------------------- Sub 写真削除1_Click() ActiveSheet.Shapes("写真1").Select Selection.Delete ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True End Sub ところどころ端折ってますが，以上のようなマクロです． よろしくお願いします．

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する