エクセルについて教えてください。
ペイントソフトなどで画像修正したあと、そのままコピー(クリップボードに)し、エクセルに任意の大きさで貼り付けたいのですが、そんなマクロできるでしょうか。
方法としては、自分が貼り付けたい大きさに結合したセルを選択し、貼り付け(クリップボードなので、右クリック貼り付け)をすると、そのセルの大きさに自動で縮小・拡大するような仕組みです。
いろいろな掲示板を見て、クリップボードからではなく、挿入から画像を選んで任意のセルの大きさで貼り付けるというマクロは発見できました。
それをちょっといじるとできそうな気がするんですが、なにぶん詳しくないもので、、、
だれかわかる方教えてください。
↓挿入からセルの大きさに合わせて貼り付けるマクロ
Sub haritukeru()
Dim c As Range, cm As Range
Application.ScreenUpdating = False
For Each c In Selection
Set cm = c.MergeArea
If c.Address = cm.Item(1).Address Then
If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub
With Selection
.Left = cm.Left
.Top = cm.Top
.Height = cm.Height
.Width = cm.Width
End With
End If
Next
Set cm = Nothing
Application.ScreenUpdating = True
End Sub
No.3
- 回答日時:
こんばんは。
>元画像より大きい枠での拡大処理はなったんですが、縮小処理は無理ですか?
私のほうは、jpg ファイルで試してみたのですが、縮小も出来ました。
もし、うまくいかないようでしたら、ワークシート上の貼り付けた画像を、右クリックコピーで、縮小サイズで、試してみてください。
No.2
- 回答日時:
こんばんは。
コントロールツールのコマンドボタンを押して貼り付けるように作りましたので、もし、違う形にしていようでしたら、他に移植してください。
手順としては、最初に、Pictureをコピーして、それから、Excelのワークシート上で、ボタンを押すと、InputBox が出てきて、範囲を設定するように求められます。それで範囲が設定したら、Ok をクリックすれば、Pictureの大きさが定まって、貼り付けられます。
'シートモジュール
'------------------------------------------------------------
Private Declare Function IsClipboardFormatAvailable _
Lib "user32.dll" _
(ByVal wFormat As Long) As Long
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPICT = 3
Private Sub CommandButton1_Click()
Dim rng As Range
Dim mLeft As Double
Dim mTop As Double
Dim mHeight As Double
Dim mWidth As Double
Dim cf As Variant
Dim clpFlg As Boolean
For Each cf In Array(CF_METAFILEPICT, CF_BITMAP)
' クリップボードのデータ形式を判定
If IsClipboardFormatAvailable(CLng(cf)) Then
clpFlg = True
End If
Next cf
If clpFlg = False Then
MsgBox "画像が確保されいてません。", 32: Exit Sub
End If
On Error Resume Next
Set rng = Application.InputBox("領域を選択してください。", Type:=8)
If rng Is Nothing Then Exit Sub
On Error GoTo 0
If rng.Count = 1 Then
MsgBox "領域を広げてください。", 32: Exit Sub
End If
With rng
mLeft = .Left
mTop = .Top
mHeight = .Cells(.Count).Offset(1).Top - .Top
mWidth = .Cells(.Count).Offset(, 1).Left - .Left
End With
On Error GoTo EndLine
Me.Pictures.Paste
With Me.Pictures(Me.Pictures.Count).ShapeRange
.Left = mLeft
.Top = mTop
.Height = mHeight
.Width = mWidth
.LockAspectRatio = msoFalse
.LockAspectRatio = msoFalse
.Parent.Visible = msoTrue
End With
Exit Sub
EndLine:
MsgBox Err.Number & ":" & Err.Description
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Excel(エクセル) Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて 2 2022/11/15 16:14
- Visual Basic(VBA) エクセル VBAについて 2 2022/05/16 16:33
- Excel(エクセル) 【マクロ】スクショ印刷がうまく動かない件 5 2022/12/06 17:37
- Visual Basic(VBA) QRコード作成マクロについて 3 2022/11/26 16:55
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) 形式を選択して貼り付け 以下のコードで「元」シートと「先」シートのA列に同じ値があったら指定範囲をコ 5 2022/11/11 07:30
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルの2ページ目の作り方
-
エクセル:マクロ「Application...
-
エクセルのアポストロフィを一...
-
エクセルで勝手に「折り返して...
-
EXCELシートをPowerPointにきれ...
-
EXCELのオートフィルの設定を変...
-
Excelでコピーした行の挿入を繰...
-
エクセルで、選択範囲の数値全...
-
Excelで、横並べのデータを縦並...
-
Excel)軽いデーターのはずなの...
-
Excelの連続データから数行おき...
-
「選択範囲を解除してアクティ...
-
エクセルオートフィルで書式を...
-
【エクセル】行の高さを規則的...
-
行数の違う表に複数行をコピーする
-
エクセルで値だけコピーして背...
-
VBAでセルがコピーされているか...
-
エクセルでの行数・列数を指定...
-
Excel 行の連続データを列に参...
-
Excelに、ダブルクォーテーショ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセル:マクロ「Application...
-
エクセルの2ページ目の作り方
-
エクセルのアポストロフィを一...
-
Excel 行の連続データを列に参...
-
エクセルで、選択範囲の数値全...
-
エクセルで勝手に「折り返して...
-
Excelでコピーした行の挿入を繰...
-
EXCELシートをPowerPointにきれ...
-
EXCELのオートフィルの設定を変...
-
エクセルでの行数・列数を指定...
-
エクセルのコピペでクリップボ...
-
Excelに、ダブルクォーテーショ...
-
エクセル 別シートへのコピー...
-
メールソフト「サンダーバード...
-
「選択範囲を解除してアクティ...
-
EXELで複数のとびとびのセルを...
-
エクセルで値だけコピーして背...
-
Excel)軽いデーターのはずなの...
-
エクセル・数値が変化したらカ...
-
Excelで、横並べのデータを縦並...
おすすめ情報