• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：削除した写真より下の写真を上に詰める）

削除した写真より下の写真を上に詰める

chayamatiの回答

  • chayamati
  • ベストアンサー率41% (254/607)
回答No.2

おはようございます。 VBAは分かりませんが、Pic.Deleteは実行できましたか？ これに伴い、 9行目から13行目迄も不要ではないですか これらの行も削除して不都合はありますか Rows("9:13").Select Selection.Delete Shift:=xlUp

1211M
質問者

お礼

早速のご回答ありがとうございました。 削除すると、その列の文言まで消えてしまいますので 不都合です。

この回答がついた質問に戻る
回答 全件
ベストアンサー
参考に 　　If UCase$(TypeName(Selection)…
アップされたコードでは範囲を選択して範囲内の写真を削除していますね >…
  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

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

    質問１ 写真を縦に取り込むには以下マクロをどのように変えたらよいのか？ を教えてください。 質問２ ＪＰＧとｊｐｇを取り込むにはどうしたらよいのでしょうか？ 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

  • 特定範囲のセルの最終文字1文字を削除

    よろしくお願いします。 Sheet1のJ26からJ56の、セルに入れた文字の最終文字1文字を 削除して表示したいのですが、下の構文で、 For Each r In Application.Selectionが黄色くエラー表示されます。 どこをどのように直せばよいのか解りません。 よろしくお願いします。 Private Sub CommandButton1_Click() Dim r As Range r = Worksheets("Sheet1").Range("J26:J56") For Each r In Application.Selection If Len(r.Value) > 0 Then r.Value = Left(r.Value, Len(r.Value) - 1) End If End Sub Next

  • Excelの写真貼り付け(90度回転)について

    xcelに写真のサイズを自動的に変更するマクロ、(セルの大きさに合わせて）を利用しています。 このマクロに対して写真を90度角度を変更して、写真を表示させたいのですが、どのようにすればよいのでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean) ActiveSheet.Unprotect 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 Range("a1").Select End Sub

  • EXCEL VBAで空白削除のマクロを作りましたが

    削除されません。 下記のとおりですが、どう考えても動きません、どなたか修正をお願いします。 初心者です。宜しくお願いします。 Sub Ksakujyo() Dim ObjRange As Range On Error Resume Next Set ObjRange = Application.InputBox("削除範囲を選択して下さい。", "印刷範囲", Type:=8) On Error GoTo 0 If ObjRange Is Nothing Then MsgBox "キャンセルされました。" End If If Selection.Count = 1 Then Exit Sub On Error Resume Next Selection.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp Exit Sub End Sub

  • 条件に合った行を削除するマクロについて

    こんにちは 今、現在、とある条件にあった行を削除するマクロ作っているのですが、 インターネットを調べてみると後ろから探索して、1行ずつ消していくのがいいと書いてありました。 まぁ、その理屈はわかるんですが、それなら 「Unionでセルの範囲を結合してから、最後に一度に消してしまった方が速いのでは」 (消す作業が1度だけで済むから) と思い試してみたんですが、実際試したところ・・・ ものすごく遅かったです。 (ちなみに、1万件のデータで削除した行数は6000ほどでした） 何故Union結合だと遅いのでしょうか？ 速いマクロを作成するには、やはり後ろから探索して、1行ずつ消していくしかないのでしょうか？ 以下は試したマクロです。 (test が　unionで試したマクロ、test2が後ろから1行ずつ削除したマクロ) Option Explicit Public Sub test() Dim r As Range Dim r1 As Range 'Cells.Replace "-", " " For Each r In Range("A2", Range("A65536").End(xlUp)) If r = r.Offset(1, 0) And r.Offset(0, 1) < r.Offset(1, 1) Then If r1 Is Nothing Then Set r1 = r Else Set r1 = Union(r1, r) End If End If Next r1.EntireRow.Delete ' r1.Select End Sub Public Sub test2() Dim r As Range Dim r1 As Range Dim i As Integer 'Cells.Replace "-", " " Application.ScreenUpdating = False For i = Range("A65536").End(xlUp).Row To 1 Step -1 If Cells(i, 1) = Cells(i + 1, 1) And Cells(i, 2) < Cells(i + 1, 2) Then Cells(i, 1).EntireRow.Delete End If Next Application.ScreenUpdating = True End Sub

  • 特定文字列を含む行を削除するマクロ

    すみませんどなたか教えてください。 エクセルで商品の在庫管理をしておりまして、AP列に製品メーカー名が入っているのですが、 いくつかの（数十個）メーカーを省き削除したく思い、以下のようなマクロをググって作ってみましたが、 上手く動きませんでした。　1つのメーカーだけ記載した場合はうまく動きました。 やりたいことは1つのマクロの中に、数十個のメーカー名を記入しておき、そのメーカーを全件 検索して、AP列に文字列が含まれる場合は、その行を削除したいです。 宜しくお願い致します。 ～～～～～～ Sub DelLines1() Dim R As Range Do Set R = ActiveSheet.Range("AP:AP").Find(What:="softbank", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop Sub DelLines2() Dim R As Range Do Set R = ActiveSheet.Range("AP:AP").Find(What:="docomo", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop Sub DelLines3() Dim R As Range Do Set R = ActiveSheet.Range("AP:AP").Find(What:="au", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop End Sub

  • VBAにて写真貼り付け

    EXCEL2010を使用しています。 Ｄ3に於いて名前を選択できるようにしています。Ｄ3に入力する名前と同一の写真（JPG)がDISK TOP上フォルダー内に複数あります。 Ｄ3で名前選択時,該当する写真をA5:M29に表示したい。 以下のコードは他の方が使われてるコードを参考にしたもので、※印の場所でエラーとなります何が 原因なのか？他の部分も合わせ教えて下さい。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$3" Then myPath = "C:\Users\Users\DeskTop\PHOT" myFile = myPath & Range("D3").Text & ".jpg" For Each sh In ActiveSheet.Shapes If Left(sh.Name, 7) = "Picture" Then sh.Delete End If Next Range("A5:M29").Select myTop = Selection.Top myLeft = Selection.Left myWidth = Selection.Width myHeight = Selection.Height ※ActiveSheet.Pictures.Insert(myFile).Select With Selection .Top = myTop .Left = myLeft .Width = myWidth '画像の幅 .Height = myHeight '画像の高さ End With Range("D3").Select End If End Sub

  • 二つの条件式を一つにまとめようとしてます。

    二つの条件式を一つにまとめようとしてます。 マクロを勉強しております。以前も質問させて頂いて、やりたい事は解決出来たのですが、更に別の事をしようと思いつまずきました。 A列の17行目まで数値が記入してあり、その順位をB列に記入するマクロを作りました。ここまでは何とか教えて頂いて出来たのですが。 さらに背景色が付いているセルを空欄にしてから順位を出そうとしました。それで、自分なりに記入して出来たのですが、この二つを一つにまとめようとしたらうまくいきません。Select case ～などを使用してみたのですが、よく分からなくなりました。どのようにしたらよいかだれか教えてください。 Sub Macro2() Dim r As Range Range("A1:A17").Select For Each r In Selection If r.Interior.ColorIndex <> xlNone Then r.Value = "" End If Next r End Sub Sub Macro1() Dim r As Range, a As Range Range("A1:A17").Select For Each r In Selection If r.Value <> "" Then r.Offset(, 1).Value = Application.WorksheetFunction.Rank(r, Selection, 1) End If Next r End Sub あと、Select しない書き方も研究してください。と指摘、頂いたのですがまだ未解決なので、そこはそのままになっております。

  • 行の削除

    列Ｋに、削除という文字が入っている場合は、その行を削除するということで、3000行くらいあるなかで3分の2程度は削除する行に該当します。 下のマクロで試してみましたが、このマクロではとっても時間がかかってしまうんですが、どうしたら早く処理できるのか教えて下さい。 Dim R As Range Do Set R = ActiveSheet.Range("K:K").Find(What:="削除", LookAt:=xlWhole) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop

  • 特定文がある行を削除

    特定分がある行を削除しようと思い、以下のように設定いたしました。 Sub DelLines() Dim R As Range Do Set R = ActiveSheet.Range("A:A").Find(What:="指定文", LookAt:=xlWhole) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop End Sub これを、全てのシートに適用するにはどのように書けばよろしいのでしょうか？

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する