エクセルでVBAを使用じ工事写真台帳を作成しています。
まだまだ初心者ですので、なかなか思うようにいきません。詳しい方助けて下さい。
何とか組んで使用できるのですが、一つのセルのみで複数選択する事が出来ません。
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Application.Intersect(Target, Range("B13:F23")) Is Nothing Then Exit Sub
Dim myF As Variant
Dim mySp As Object
Dim myAD1 As String
Dim myAD2 As String
Dim myHH As Double
Dim myWW As Double
Dim myHH2 As Double
Dim myWW2 As Double
Cancel = True
'===============画像選択
myF = Application.GetOpenFilename _
("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
If myF = False Then
MsgBox "画像を選択してください(終了)"
Exit Sub
End If
'===============画像の掃除
For Each mySp In ActiveSheet.Shapes
myAD1 = mySp.TopLeftCell.MergeArea.Address
myAD2 = Target.Address
If myAD1 = myAD2 Then mySp.Delete
Next
'===============画像の貼り付け
Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _
SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _
Width:=0, Height:=0) '★ とりあえず 縦横0で。
mySp.ScaleHeight 1, msoTrue '★元のサイズに戻す
mySp.ScaleWidth 1, msoTrue '★元のサイズに戻す
'===============タテヨコの縮尺を保持
If mySp.Width > Target.Width Then mySp.Width = Target.Width
If mySp.Height > Target.Height Then mySp.Height = Target.Height
'===============中央へ調整
myHH2 = (Target.Height / 2) - (mySp.Height / 2)
myWW2 = (Target.Width / 2) - (mySp.Width / 2)
mySp.Top = Target.Top + myHH2
mySp.Left = Target.Left + myWW2
Set mySp = Nothing
End Sub
上から3行目の(Target, Range("B13:F23"))で、このセルにはダブルクリック、フォルダー選択、写真貼付けができます。
ただ複数選択する事が出来ません。
うまく伝えられず、申し訳ありませんが詳しい方、ご回答宜しくお願い致します。
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.2
- 回答日時:
No.1です。
お礼に書かれている回答内容が意味不明ですが・・・。「選択したファイルを選択したセルに張り付ける」というのが本来の仕様と認識していますが、ダブルクリックでは複数のセルを選択することができません。よって、選択した2つ目以降のファイルの貼り付け先をどうするか、決め事が必要になります。
とりあえず、選択したセルから右へ順に張り付けるサンプルを作ってみました。変更箇所はご自分で確認してください。ご検討をお祈りします。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Application.Intersect(Target, Range("B13:F23")) Is Nothing Then Exit Sub
Dim myF As Variant
Dim myFs As Variant
Dim mySp As Object
Dim myAD1 As String
Dim myAD2 As String
Dim myHH As Double
Dim myWW As Double
Dim myHH2 As Double
Dim myWW2 As Double
Cancel = True
'===============画像選択
myFs = Application.GetOpenFilename _
("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , True)
If Not IsArray(myFs) Then
MsgBox "画像を選択してください(終了)"
Exit Sub
End If
For Each myF In myFs
'===============画像の掃除
For Each mySp In ActiveSheet.Shapes
myAD1 = mySp.TopLeftCell.MergeArea.Address
myAD2 = Target.Address
If myAD1 = myAD2 Then mySp.Delete
Next
'===============画像の貼り付け
Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _
SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _
Width:=0, Height:=0) '★ とりあえず 縦横0で。
mySp.ScaleHeight 1, msoTrue '★元のサイズに戻す
mySp.ScaleWidth 1, msoTrue '★元のサイズに戻す
'===============タテヨコの縮尺を保持
If mySp.Width > Target.Width Then mySp.Width = Target.Width
If mySp.Height > Target.Height Then mySp.Height = Target.Height
'===============中央へ調整
myHH2 = (Target.Height / 2) - (mySp.Height / 2)
myWW2 = (Target.Width / 2) - (mySp.Width / 2)
mySp.Top = Target.Top + myHH2
mySp.Left = Target.Left + myWW2
Set mySp = Nothing
Set Target = Target.Offset(0, 1)
Next myF
End Sub
No.1
- 回答日時:
GetOpenFilenameメソッドのMultiSelectオプションにTrueを指定すれば複数ファイルを選択することができるようになります。
しかし、ダブルクリックイベントプロシジャで受け取れるTargetセルは1つのみです。要するに複数のファイルを選択しても貼り付け先のセルが1つしかないので、残りのファイルをどうするか決める必要があります。同じセルに重ねて張りますか?それとも右隣(または下)に貼りますか?ママチャリさん
回答ありがとうございます。
複数選択は、A4サイズに3枚、4枚と貼り付けたいです。
やはりこのプログラムでは無理ですか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて 2 2022/11/15 16:14
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 2 2022/05/26 17:19
- PowerPoint(パワーポイント) ExcelのVBAコードについて教えてください。 3 2022/05/25 14:32
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) [Excel VBA] このコードでは行の挿入や行の消去をすると13のエラーが出てしまう。 3 2022/12/09 00:29
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Visual Basic(VBA) 【変更】ファイルを閉じてダイアログで保存した時、更新したシートだけの処理の実行をする 5 2022/03/26 18:31
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
エクセル マクロ写真帳に一括で写真を張り付けたいです。
Visual Basic(VBA)
-
【EXCEL VBA】ダブルクリックでセルのサイズに合わせて画像を挿入に機能を追加したいです。
Visual Basic(VBA)
-
Excel 画像貼り付けのVBAについて
Excel(エクセル)
-
-
4
VBAエクセルに貼り付けた画像をセルにあった大きさにしたい(等倍)
Excel(エクセル)
-
5
マクロ 写真を複数挿入
Excel(エクセル)
-
6
セルサイズに自動で合わせて画像を貼るマクロとカレンダーマクロでエラー表示・変数宣言とは。
Excel(エクセル)
-
7
VBAで「エクセルに写真を貼り付け、外のセルに撮影月日を『和暦』で自動記載」させたい
Excel(エクセル)
-
8
【VBA】写真の貼り付けコードがうまく機能しません。
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
excelで、スクロールをすると限...
-
エクセルで連続データから、数...
-
EXCEL アルファベットと数字の...
-
セルをクリックすると付箋のよ...
-
エクセルの画面で十字マークが...
-
excelで1行ごとに一気に削除す...
-
エクセルでハイパーリンクのU...
-
Excelで表のデータを並び替えた...
-
複数のセルの入力内容を一度に...
-
ピポットテーブルエラー解決方法
-
Excel選択を繰り返すとセルの色...
-
エクセル2016の特定の文字列を...
-
エクセルで0を除いて昇順に並...
-
EXCEL オートフィルタの結果に...
-
連続データの作成(E)が選択出来...
-
フィルタを解除した後の表示位置
-
エクセルの名簿を50音順にしたい
-
エクセル エンターキーを押す...
-
余計なお世話的な「入力規則」...
-
EXCELで広い範囲のセルに簡単に...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
excelで、スクロールをすると限...
-
エクセルの画面で十字マークが...
-
エクセルで連続データから、数...
-
EXCEL アルファベットと数字の...
-
セルをクリックすると付箋のよ...
-
エクセル 数値を全て「1」にす...
-
エクセルでハイパーリンクのU...
-
excelで1行ごとに一気に削除す...
-
Excel選択を繰り返すとセルの色...
-
エクセル 画面上の行数を調節...
-
Excelで表のデータを並び替えた...
-
複数のセルの入力内容を一度に...
-
エクセルVBAでセル範囲のデータ...
-
ピポットテーブルエラー解決方法
-
エクセルで「1~15」の乱数...
-
エクセルでカーソルが四方に矢...
-
Shift押しながら、矢印ボタンで...
-
エクセルで0を除いて昇順に並...
-
Excelで急に動かなくなる
-
エクセルで任意のセルをクリッ...
おすすめ情報