ここから本文です

マクロ初心者です。詳しい方助けてください。

chi********さん

2016/12/2811:48:32

マクロ初心者です。詳しい方助けてください。

ほかサイトから探して引用したマクロでなんとか少しづつかえていい位置に画像をうめこめたのですが、直したいところ等があり、試行錯誤しています詳しい方に助けてほしいです。。

やりたいのは
・I4から3行間隔をあけ50枚ほど写真を挿入したい
・ファイル名とかは必要ない(今のマクロだと表示されてしまう)
・画像の名前順に挿入していきたい(今のマクロだとばらばらの順番になってしまう)
・I4セルのサイズが343×48なのですが、そのセルにぴったり合うように表示したい。(今のマクロだと少しサイズがあってない)

↓今使用している引用してきたマクロ


Sub InsertPictures()
Dim i As Integer
Dim myDir As String
Const myHeight = 353 '行の高さ。0-409を指定。写真のサイズがこれで調整される。
Const myWidth = 48 '列の幅。0 - 255を指定。
Dim myFName As String

myDir = Application.GetOpenFilename(FileFilter:="すべての図(*.jpg),*.jpg")
If myDir = "False" Then Exit Sub
myDir = Left(myDir, Len(myDir) - Len(Dir(myDir)))

Application.ScreenUpdating = False
ActiveSheet.DrawingObjects.Delete
Columns(2).ClearContents
Rows.AutoFit

i = 1
myFName = Dir(myDir & "*.jpg")

Do While myFName <> ""
With Cells((i - 1) * 4 + 4, 9)
.Activate
.RowHeight = myHeight
End With
With ActiveSheet
.Pictures.Insert myDir & myFName
With .Shapes(i)
.LockAspectRatio = msoTrue
.Height = myHeight
End With
End With
Cells(i, 2).Value = myFName
myFName = Dir
i = i + 1
Loop

Columns(1).ColumnWidth = myWidth
Columns(2).AutoFit
Application.ScreenUpdating = True
End Sub

閲覧数:
129
回答数:
2

違反報告

ベストアンサーに選ばれた回答

だるまさん

2016/12/2816:10:38

>マクロ初心者です。

では、こんなフリーソフトはいかがでしょうか。


画像貼付Express
http://www.vector.co.jp/soft/winnt/business/se513830.html

実用的な機能に絞り【簡単操作】を実現した、ワークシート画像貼付ソフトです。



画像貼付名人
http://www.vector.co.jp/soft/winnt/business/se509888.html

複数画像の貼り付けと調整が簡単に出来ます。

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜1件/1件中

プロフィール画像

カテゴリマスター

kky********さん

2016/12/2912:24:42

こんな感じでステップはかなり少なくして出来ます。

Sub Sample()
Dim i As Integer
Dim myDir As String
Dim myFName As String
Dim shp As Shape
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
myDir = .SelectedItems(1) & "\"
End With
Application.ScreenUpdating = False
ActiveSheet.DrawingObjects.Delete
i = 1
myFName = Dir(myDir & "*.jpg")
Do While myFName <> ""
With Cells((i - 1) * 4 + 4, 9)
Set shp = ActiveSheet.Shapes.AddPicture(Filename:=myDir & myFName, _
LinkToFile:=False, SaveWithDocument:=True, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
End With
myFName = Dir
i = i + 1
Loop
Application.ScreenUpdating = True
End Sub

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる