●詳細● 

　指定セル範囲をピクチャとしてコピーして別シートに貼り付けるで、シート1のセル
　範囲（A1:B3）をクリップボードにピクチャ（画像）としてコピーし、新規に追加し
　たシートのセル（C5）に貼り付けるという処理を行いました。 
　
　今回は、貼り付けられたピクチャ（画像）の書式変更および、新規追加シートに対し
　てオブジェクトのみを保護するよう設定します。 
　オブジェクトのみを保護することにより、ユーザーからの変更が不可能なセルとして
　利用する事ができます。他のセルは入力可能です。 
　指定セル範囲をピクチャとしてコピーして別シートに貼り付けるの処理を確認したい
　場合は、指定セル範囲をピクチャとしてコピーして別シートに貼り付けるの処理が終了
　した時点で処理を確認するかどうかの判断を促すメッセージボックスが表示されるので、
　先に進む場合は「はい」を、確認する場合は「いいえ」を押下してください。 
　シートの保護については、ワークシートの保護設定・解除を参照してください。 
　パスワードを設定して保護する場合、パスワードを忘れると、保護解除ができなくなっ
　てしまうので注意してください。パスワードおよび対応するシート名の対応表を作成し
　たり、保護する前にバックアップをしておくなど、保護する際には十分気を付けてくだ
　さい。 



●準備● 
新規ブックを用意して標準モジュールを挿入し、サンプルマクロを貼り付けてください。 

●サンプル● 

Sub Sample() 
    Dim myWeekday As Integer 
    Dim myMsg As String, myStyle As String, Answer As String

    Worksheets(1).Activate 


    '＜現在の日付を取得します。＞ 
    Range("A1").Value = "日付" 
    Range("B1").Value = Date 


    '＜現在の時刻を取得します。＞ 
    Range("A2").Value = "時間" 
    Range("B2").Value = Time 


    '＜今日の曜日を取得します。＞ 
    Range("A3").Value = "曜日" 
    myWeekday = Weekday(Date) 


    '＜Weekday関数の戻り値から曜日名を取得します。＞ 
    Select Case myWeekday 
      Case 1 
        Range("B3") = "日曜日" 
      Case 2 
        Range("B3") = "月曜日" 
      Case 3 
        Range("B3") = "火曜日" 
      Case 4 
        Range("B3") = "水曜日" 
      Case 5 
        Range("B3") = "木曜日" 
      Case 6 
        Range("B3") = "金曜日" 
      Case 7 
        Range("B3") = "土曜日" 
      Case Else 
        Range("B3") = "？曜日" 
    End Select 


    '＜指定セル範囲をクリップボードへピクチャ (画像) 
    ' としてコピーします。＞ 
    Columns("A:B").EntireColumn.AutoFit 
    ActiveSheet.Range("A1:B3") _ 
      .CopyPicture xlScreen, xlBitmap 


    '＜新規シートを最後のシートの直後に挿入します。＞ 
    Sheets.Add after:=Worksheets(Worksheets.Count) 
    '＜新規シートに貼り付けします。＞ 
    ActiveSheet.Paste Destination:= _ 
      ActiveSheet.Range("C5") 



'―――――――――――――――――――――――――――
'　指定セル範囲をピクチャとしてコピーして別シートに貼り付けるの処理はここまで 
'―――――――――――――――――――――――――――



    '＜メッセージボックスのメッセージを定義します。＞ 
    myMsg = "オブジェクトの書式設定及び保護を行いますか？" & Chr(13) & _ 
      "Vol.18の処理を確認する場合は「いいえ」を押下してください。" 


    '＜メッセージボックスのボタンを定義します。＞ 
    myStyle = vbYesNo + vbQuestion 


    '＜メッセージボックスを表示します。＞ 
    Answer = MsgBox(myMsg, myStyle) 



    '＜[いいえ] がクリックされた場合、処理を終了します。＞ 
    If Answer = vbNo Then 
      Exit Sub 
    End If 


    '＜貼り付けたピクチャ（画像）を選択します。＞ 
    ActiveSheet.Shapes(1).Select 

    With Selection.ShapeRange 
      '＜サイズを変更します。＞ 
      .Height = 60.6 
      .Width = 132.6 
      '＜輪郭線の太さを設定します。＞ 
      .Line.Weight = 4.5 
      '＜輪郭線のスタイルを設定します。＞ 
      .Line.Style = msoLineThickThin 
      '＜輪郭線を表示するに設定します。＞ 
      .Line.Visible = msoTrue 
      '＜輪郭線の前景色を設定します。＞ 
      .Line.ForeColor.SchemeColor = 12 
      '＜移動させます。＞ 
      .IncrementLeft -45.6 
      .IncrementTop -37.2 
    End With 


    '＜シートの保護を設定します。＞ 
    ActiveSheet.Protect password:="VBASample", _ 
      DrawingObjects:=True, _ 
      Contents:=False, _ 
      Scenarios:=False, _ 
      userinterfaceonly:=True 

    MsgBox "オブジェクトのみ保護されたことを確認してください。" 

End Sub 



●補足説明● 



(1)IncrementLeftメソッドは、指定された図形を水平方向にポイント単位で移動します。 
　　図形を水平方向にどのくらい移動するかをポイント単位で指定します。 
　　正の値を指定すると図形は右に移動し、負の値を指定すると左に移動します。 


(2)IncrementTopメソッドは、指定された図形を垂直方向にポイント単位で移動します。 
　　図形を垂直方向にどのくらい移動するかをポイント単位で指定します。 
　　正の値を指定すると図形は下に移動し、負の値を指定すると上に移動します。