'========================================================================================= ' 177 リンク貼り付けする '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。(概ね下半分) ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。(概ね上半分) '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim 左上端 As Variant '★★★ Dim 初回 As Integer Dim タイトル As String Dim スタイル As Long Dim メッセージ As String Dim 応答 As Variant '========================================================================================= Private Sub リンク貼り付けする() '★★★ Range(左上端).Select ActiveSheet.Paste Link:=True End Sub '========================================================================================= '----------------------------------------------------------------------------------------- Sub おためしマクロ() おためしメッセージを表示する If 初回 = 1 Then GoTo リスタート End If 初回 = 1 ' Worksheets("Title").Activate Range("E8:G9").Copy 'コピーする 左上端 = "E11" '貼り付け範囲の左上端セル リンク貼り付けする '★★★ ' 結果確認メッセージを表示する Exit Sub ' リスタート: スタイル = 16 'vbCritical メッセージ = "リスタート機能はありません" & Chr(13) & Chr(13) & _ "ブックを開き直してください" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する() Worksheets("Title").Select Range("G8").Select 'コピー元の数式をわかり易く見せるため ' タイトル = "500連発 第2弾 サンプルマクロ" スタイル = 64 'vbInformation メッセージ = "E8:G9セルをコピーして、" & Chr(13) & Chr(13) & _ "E11セルを左上端とする範囲に、リンク貼り付けします。" & Chr(13) & Chr(13) & _ "(数式バーに表示されている数式を、見ておいてください)" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub 結果確認メッセージを表示する() Range("G11").Select '貼り付け結果をわかり易く見せるため メッセージ = "G11セルに貼り付けられた数式は、" & Chr(13) & Chr(13) & _ "E8セルの数式とは異なります。" & Chr(13) & Chr(13) & _ " (数式バーで見てください)" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Sub Auto_Close() Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない ActiveWorkbook.Close '現在開いているブックを閉じる End Sub '-----------------------------------------------------------------------------------------