MW211 EXIT

devlog
ExcelVBA/図形のシート間全コピー
2018年07月21日
┌──────────────────────────────────────┐
│Dim i As Integer                                                            │
│Dim 図形名 As String, 上 As Double, 左 As Double, 縦 As Double, 横 As Double│
│With 入力シート                                                             │
│    For i = 1 To .Shapes.Count                                              │
│        With .Shapes(i)                                                     │
│            図形名 = .Name                                                  │
│            上 = .Top                                                       │
│            左 = .Left                                                      │
│            縦 = .Height                                                    │
│            横 = .Width                                                     │
│            .Copy                                                           │
│        End With                                                            │
│        With 出力シート                                                     │
│            .Select                                                         │
│            .Paste                                                          │
│            If VarType(Selection) = vbObject Then                           │
│                Selection.Name = 図形名  ' 日本語既定名は英語になるので注意 │
│            End If                                                          │
│            With .Shapes(図形名)                                            │
│                .Top = 上                                                   │
│                .Left = 左                                                  │
│                .Height = 縦                                                │
│                .Width = 横                                                 │
│            End With                                                        │
│            .Cells(1, 1).Select                                             │
│        End With                                                            │
│    Next i                                                                  │
│End With                                                                    │
└──────────────────────────────────────┘
コピーして名称を合わせて位置も合わせた。

AcitiveXコントロールの場合は、ペーストを選択(Selection)されない代わり
図形名は同じになるので、それ以外の場合のみ図形名を合わせる処理を行い
その後、図形名が同じという前提で、位置を合わせた。

なお、日本語既定名は実体は英語名なので、英語名としてコピーされてしまう。
分類:ExcelVBA