1. Home » 
2. Excel講座の総目次 » 
3. Excel VBA入門：目次 » 
4. 図を移動・コピーする

図を移動・コピーする:Excel VBA入門

はじめに　　　Topへ

• ここでは、セルで選択した国の国旗をセルに表示する方法です。
• B3セルには入力規則のリストを設定しています。A12:A23の国名をリスト表示するようにしています。
  C1セルにはどの国が選択されたかを調べるため、=MATCH(B3,A12:A23,0)　と入力しています。
  移動する各国旗の図は国名と同じ順番に　図21、図2・・・図32　と名前を付けています。
  
  • 図の名前は各国旗を選択して、図21　のように名前ボックスに入力しています。
    

図を移動する　　　Topへ

• 各国の国旗をI列とK列に並べてみます。
  国旗(図)の大きさから4行目おきに並べてみます。
  • コードは標準モジュールに入力しました。
    

    Sub zu_reset() 　Dim i As Integer 　For i = 21 To 26 　　　Worksheets("Sheet1").Shapes("図" & i).Select 　　　Selection.ShapeRange.Left = Cells(4 * (i - 20), 9).Left 　　　Selection.ShapeRange.Top = Cells(4 * (i - 20), 9).Top 　Next i 　For i = 27 To 32 　　　Worksheets("Sheet1").Shapes("図" & i).Select 　　　Selection.ShapeRange.Left = Cells(4 * (i - 26), 11).Left 　　　Selection.ShapeRange.Top = Cells(4 * (i - 26), 11).Top 　Next i 　Range("A1").Select End Sub

  • このコードを実行すると、下図のようにI列とK列に並びました。
    
• B3セルで選択した国名に対応した国旗をD3セルに移動します。
  • コードはSheet1に入力しました。
    • D3セルに移動しますが、セルから少しだけ離したいので、Range("D3").Left + 5　Range("D3").Top + 3
    と調整値を加えています。
    

    Private Sub Worksheet_Change(ByVal Target As Range) ' ' 図21~32の12枚 ' 　Dim i As Integer 　　If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub 　　'図をそれぞれ元の位置に表示する 　　For i = 21 To 26 　　　　Worksheets("Sheet1").Shapes("図" & i).Select 　　　　Selection.ShapeRange.Left = Cells(4 * (i - 20), 9).Left 　　　　Selection.ShapeRange.Top = Cells(4 * (i - 20), 9).Top 　　Next i 　　For i = 27 To 32 　　　　Worksheets("Sheet1").Shapes("図" & i).Select 　　　　Selection.ShapeRange.Left = Cells(4 * (i - 26), 11).Left 　　　　Selection.ShapeRange.Top = Cells(4 * (i - 26), 11).Top 　　Next i 　'選択した国の国旗をD3セル移動する 　　Worksheets("Sheet1").Shapes("図" & 20 + Range("C3").Value).Select 　　Selection.ShapeRange.Left = Range("D3").Left + 5 　　Selection.ShapeRange.Top = Range("D3").Top + 3 　　Range("I1").Select End Sub

  • B3セルで選択した国の国旗がC3セル付近に表示されました。
    
    
    表示例2
    

図を別のシートからコピーする　　　Topへ

• Sheet1の図をコピーして、Sheet3へ貼り付ける例です。
  上記と同様に、A2セルに入力規則で設定した国に対応する国旗をC2セルに表示します。
  Sheet3に貼り付けた図を一旦削除してから、貼り付けています。
  

  Private Sub Worksheet_Change(ByVal Target As Range) 　　Dim myShape As Variant 　　Dim myCnt As Integer 　　If Intersect(Target, Range("A2")) Is Nothing Then Exit Sub 　　' 図を削除 　　　Worksheets("Sheet3").Select 　　　For Each myShape In Worksheets("Sheet3").Shapes 　　　　　If Left(myShape.Name, 1) = "図" Then 　　　　　　　myShape.Delete 　　　　　End If 　　　Next 　　'選択した図をコピーして貼り付ける 　　　myCnt = Worksheets("Sheet3").Range("B2").Value 　　　Worksheets("Sheet1").Shapes("図" & myCnt + 20).Copy 　　　ActiveSheet.Paste 　　　Selection.Top = Range("C2").Top + 5 　　　Selection.Left = Range("C2").Left + 3 　　　Range("a1").Select End Sub

• 実行後の画面
  
  A2で「日本」を選択した例です。
  

スポンサードリンク

PageViewCounter
　
　Since2006/2/27