すぐに役立つエクセルVBAマクロ集 - すぐマク
すぐに役立つ Excel VBA マクロ集 Excel VBA Macro
Macro
Google
 
Home　|　 What's New!　|　 Gallery　|　 Introduction　|　 Service　|　 Profile

500連発・組み方講座フォロー

Big Color Pallet
[広告]
　
Excel VBA Macro
Excel DownLoad
© 1997 - 2007
Yoshioh Nagai.
All RightsReserved.
HappyTech & Co., Ltd.
www.happy500z.com
Sample Macro　　その他 Previous Next
その他
[基本型]
 		1) 折れ線グラフを作成する
2) 図形の名前・削除・複製
3) 画像の名前・削除・複製（95仕様）
4) 図形の左上端をセルの左上端に合わせる
5) 図形とその文字列を変更可能にしてシートを保護
6) Excelのバージョンを表示する
7) Excelのグローバル一意識別子を表示
8) プロダクトIDを表示する
9) OSの名前を表示する
10) ユーザー名を表示する
11) コンピュータ名を表示する
12) VBProjectにアクセスする
13) ハイパーリンクを挿入する
14) ハイパーリンク先のファイルを表示する
15) ExcelからWord文書を開く

1) 折れ線グラフを作成する もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub 折れ線グラフを作成する()
    シート名 = "SSS"                            '※１
    Set データ範囲 = Worksheets(シート名).Range("A1:D4") '※１
    グラフ種類 = xlLineMarkers                  'データマーカー付き折れ線
    プロット方法 = xlRows
    グラフ作成場所 = xlLocationAsObject
    With Charts.Add
        .ChartType = グラフ種類
        .SetSourceData Source:=データ範囲, PlotBy:=プロット方法
        .Location Where:=グラフ作成場所, Name:=シート名
    End With
End Sub
'=========================================================================================
＜コメント＞
処理概要
※１ シート名、データ範囲を記述

2) 図形の名前・削除・複製 もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub 図形の名前を調べる()
    図形の名前 = ActiveSheet.Shapes(1).Name '図形の名前を調べる
'=========================================================================================
Sub 指定した図形を削除する()
    ActiveSheet.Shapes(1).Delete        'アクティブシートのインデクス番号1の図形を削除する
End Sub
'----------------------------------------------------------------------------------------
Sub すべての図形を選択して削除する()
Dim 対象シート As Object                '変数「対象シート」はオブジェクト型
    Set 対象シート = ActiveSheet        'オブジェクトへの参照を変数に代入する
    対象シート.Shapes.SelectAll         'すべての図形を選択する
    Selection.Delete                    '現在選択されているオブジェクトを削除する
End Sub
'----------------------------------------------------------------------------------------
Sub 指定した種類の図形を削除する()
Dim 図形 As Shape
    For Each 図形 In ActiveSheet.Shapes
        If 図形.Type = msoFormControl Then '※２
            図形.Delete                 '図形を削除する
        End If
    Next
End Sub
'----------------------------------------------------------------------------------------
Sub 指定したセル範囲にある図形を削除する()
    指定セル範囲 = "B2:F20"
    With ActiveSheet
    Set セル範囲 = .Range(指定セル範囲)
    For Each 図形 In .Shapes
        If 図形.Type = msoPicture Then
            Set 共有セル範囲 _
                = Intersect(Range(図形.TopLeftCell, 図形.BottomRightCell), セル範囲)
            If Not (共有セル範囲 Is Nothing) Then
                図形.Delete
            End If
      End If
    Next
  End With
End Sub
'----------------------------------------------------------------------------------------
Sub 図形の名前を調べて削除する()
    図形の名前 = ActiveSheet.Shapes(1).Name '図形の名前を調べる
    ActiveSheet.Shapes(図形の名前).Delete   '図形の名前を指定して削除する
End Sub
'----------------------------------------------------------------------------------------
Sub 指定した図形を切り取る()
    ActiveSheet.Shapes(1).Cut               'アクティブシートのインデクス番号1の図形
End Sub
'=========================================================================================
Sub 図形を複製する()
    Set px = ActiveSheet.Shapes(1).Duplicate
End Sub
'=========================================================================================
Sub 図形を指定セルの左上端に接するように移動する()
    ActiveSheet.Shapes(1).Left = Columns("A").Left
    ActiveSheet.Shapes(1).Top = Rows(1).Top
End Sub
'=========================================================================================
＜コメント＞
※１ Shapesコレクション（Excel97以上用）は指定された文書のすべての描画レイヤのオブジェクト
　　　（オートシェイプ、フリーフォーム、OLE オブジェクト、ピクチャなど）
※２ 引数Typeの定数msoFormControl はフォームコントロール、定数一覧表は こちら
サンプルブック「図形を削除する」のダウンロードは ここをクリック　（YNxv212_Shapes_delete.xls　60KB）
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。

3) 画像の名前・削除・複製 （Excel95仕様） もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Private Sub 画像の名前を調べる()
    画像の名前 = ActiveSheet.Pictures(1).Name 'アクティブシートのインデックス番号1の画像
End Sub
'----------------------------------------------------------------------------------------
Sub 指定した画像を削除する()
    ActiveSheet.Pictures(1).Delete
End Sub
'----------------------------------------------------------------------------------------
Private Sub 画像を複製する()
    Set px = ActiveSheet.Pictures(1).Duplicate
End Sub
'=========================================================================================
サンプルブックのダウンロードは下記リンクをクリック
　画像の名前を調べる （YNxv212_picture.xls　59KB）、　画像を削除する （YNxv212_picture_delete.xls　60KB）
　画像を複製する （YNxv212_picture_duplicate.xls　44KB）
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。

4) 図形の左上端をセルの左上端に合わせる もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub 図形の左上端をセルの左上端に合わせる()
    With Worksheets("SSS")                      '※１
        .Shapes(1).Left = Range("B6").Left      '左端 ※２
        .Shapes(1).Top = .Range("B6").Top       '上端 ※２
    End With
End Sub
'=========================================================================================
＜コメント＞
※１ SSSにはシート名を記入
※２ B6には合わせたいセルのアドレスを記入

5) 図形とその文字列を変更可能にしてシートを保護 もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub 図形とその文字列を変更可能にしてシートを保護する()
    ActiveSheet.Shapes.AddShape(msoShapeRectangularCallout, 64.5, 33#, 89.25, _
        42.75).Select                           '※１ オートシェイプの吹き出しを作成
    With Selection
        .Characters.Text = "図形の文字列"       '※２ 選択中の文字列を設定
        .Locked = False                         '図形オブジェクトの変更可能
        .LockedText = False                     '文字列を保護しない
    End With
    ActiveSheet.Protect DrawingObjects:=True    'シートを保護(描画オブジェクトも)
End Sub
'=========================================================================================
＜コメント＞
※１ このオートシェイプは例
※２ 文字列は例

6) Excelのバージョンを表示する もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub Excelのバージョンと商品名を表示する()       'WindowsとMacintoshの混在環境用
    #If Mac Then                                'Macintoshなら
        Excelのバージョンと商品名を表示する_Mac用
    #Else
        Excelのバージョンと商品名を表示する_Win用
    #End If
End Sub
'-----------------------------------------------------------------------------------------
Sub Excelのバージョンと商品名を表示する_Win用() 'Windowsパソコンだけの環境用
    バージョン = Application.Version            'バージョン番号を取得
    Select Case Val(バージョン)
        Case Is >= 12
            商品名 = "2007"
        Case Is >= 11
            商品名 = "2003"
        Case Is >= 10
            商品名 = "2002"
        Case Is >= 9
            商品名 = "2000"
        Case Is >= 8
            商品名 = "97"
        Case Is >= 7
            商品名 = "95"
        Case Else
            商品名 = "不明"
    End Select
    MsgBox "Excel " & 商品名 & " (V" & バージョン & "）", , "すぐマク"
End Sub
'-----------------------------------------------------------------------------------------
Sub Excelのバージョンと商品名を表示する_Mac用() 'Macintoshパソコンだけの環境用
    バージョン = Application.Version
    Select Case Val(バージョン)
        Case Is >= 11
            商品名 = "2004"
        Case Is >= 10
            商品名 = "v.X"
        Case Is >= 9
            商品名 = "2001"
        Case Is >= 8
            商品名 = "98"
        Case Else
            商品名 = "不明"
    End Select
    MsgBox "Excel " & 商品名 & " (V" & バージョン & "）", , "すぐマク"
End Sub
'=========================================================================================
＜コメント＞
※１ Excelのバージョンは[Microsoft Excel のバージョン情報]ダイアログに表示される
[Microsoft Excel のバージョン情報]ダイアログ

7) Excelのグローバル一意識別子を表示 もくじへ 使用可能なExcelのバージョン 
メッセージボックス
'=========================================================================================
Sub Excelのグローバル一意識別子を表示する()
    一意識別子 = Application.ProductCode
    MsgBox 一意識別子, , "すぐマク"
End Sub
'=========================================================================================


8) プロダクトIDを表示する もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub プロダクトIDを表示する()
    バージョン = Application.Version
    一意識別子 = Application.ProductCode
    レジストリキー = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\" _
        & バージョン & "\Registration\" & 一意識別子 & "\ProductID"
    プロダクトID = CreateObject("WScript.Shell").RegRead(レジストリキー)
    MsgBox プロダクトID, , "すぐマク"
メッセージボックス
End Sub
'=========================================================================================
＜コメント＞
※１ プロダクトIDは[Microsoft Excel のバージョン情報]ダイアログにも
　　　表示される

9) OSの名前を表示する もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub OSの名前を表示する()
    osvsn = Application.OperatingSystem         'OSのバージョン情報を取り出す
    If osvsn = "Windows (32-bit) NT 5.01" Then
        商品名 = "Windows XP"
    ElseIf osvsn = "Windows (32-bit) NT 5.00" Then
        商品名 = "Windows 2000"
    ElseIf osvsn = "Windows (32-bit) 4.90" Then
        商品名 = "Windows Me"
    ElseIf osvsn = "Windows (32-bit) 4.10" Then
        商品名 = "Windows 98"
    ElseIf osvsn = "Windows (32-bit) 4.00" Then
        商品名 = "Windows 95"
    ElseIf osvsn = "Macintosh (PowerPC) 10.13" Then
        商品名 = "Mac OS X"
    ElseIf osvsn = "Macintosh (PowerPC) 9.00" Then
        商品名 = "Mac OS 9"
    Else                                        'それ以外
        商品名 = "不明"
    End If
    タイトル = "使用中のOSの名前とバージョン、商品名は"
    MsgBox osvsn & Chr(13) & 商品名 & " です", vbInformation, タイトル
End Sub
'=========================================================================================

10) ユーザー名を表示する もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub ユーザー名を表示する()
    MsgBox Application.UserName
End Sub
'----------------------------------------------------------------------------------------
使用可能なExcelのバージョン 
'----------------------------------------------------------------------------------------
Sub ユーザー名を表示する()
    MsgBox CreateObject("WScript.Network").UserName
End Sub
'=========================================================================================

11) コンピュータ名を表示する もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub コンピュータ名を表示する()
    MsgBox CreateObject("WScript.Network").ComputerName
End Sub
'=========================================================================================

12) VBProjectにアクセスする もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub アクティブなプロジェクトの名前を表示する()  '※１
    MsgBox Application.VBE.ActiveVBProject.Name
End Sub
'----------------------------------------------------------------------------------------
Sub VisualBasicプロジェクトの名前を表示する()   '※１
    MsgBox ThisWorkbook.VBProject.Name
End Sub
'----------------------------------------------------------------------------------------
Sub VisualBasicプロジェクトの名前を変更する()   '※１
    ThisWorkbook.VBProject.Name = "NewProject"  '※２
End Sub
'----------------------------------------------------------------------------------------
Sub 標準モジュールをインポートする()            '※１
    Application.VBE.ActiveVBProject.VBComponents.Import "C:\Module1.bas"  '※３、※４
End Sub
'=========================================================================================
＜コメント＞
※１ Excel2002でこのマクロを実行するには、[セキュリティ]ダイアログの［Visual Basic プロジェ
　　　クトへのアクセスを信頼する］にチェックが必要（ウィルス対策のためには危険な行為です）
※２ "NewProject"には新しい名前
※３ "C:\Module1.bas"には予めエクスポートしておいたファイルを指定する
※４ 新しいブックにインポートすればモジュールを追加したことになる

13) ハイパーリンクを挿入する もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub ハイパーリンクを挿入する()
    表示文字列 = "すぐに役立つエクセルVBAマクロ集"
    アドレス = "http://www.geocities.jp/happy_ngi/"
    Range("A1").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
        Address:=アドレス, TextToDisplay:=表示文字列
End Sub
'-----------------------------------------------------------------------------------------
Sub ハイパーリンクと表示文字列を削除する()
    Range("A1").Hyperlinks.Delete
    Range("A1").ClearContents
End Sub
'=========================================================================================

14) ハイパーリンク先のファイルを表示する もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub ハイパーリンク先のファイルを表示する()
    ActiveWorkbook.FollowHyperlink _
        Address:="http://www.happy500z.com/YNxv201.html", _
        SubAddress:="#2", _
        NewWindow:=True                         '※１、２、３、４
End Sub
'=========================================================================================
＜コメント＞
※１ 引数Addressには目的の文書（html、xls、doc等）のアドレスを指定する
※２ 引数SubAddressには目的の文書内の位置を指定（省略可）
※３ 引数NewWindow： True=新しいウィンドウに表示（既定値はFalse）
※４ FollowHyperlinkメソッドは、既にダウンロードしてあるとキャッシュのファイルを表示

15) ExcelからWord文書を開く もくじへ 使用可能なExcelのバージョン 
'=========================================================================================
Sub ExcelからWordを起動して文書を開く()
Dim ワード As Object
Dim ワード文書 As Object
Dim フルパス As String
'
    フルパス = "C:\A\サンプル.doc"              'フルパスを作成
    Set ワード = CreateObject("Word.Application") 'Wordを起動する
    ワード.Visible = True                       'Wordを表示する
    Set ワード文書 = ワード.documents.Open(フルパス) 'Word文書を開く
End Sub
'-----------------------------------------------------------------------------------------
Sub ExcelからWord文書を開いて表示する()
Dim ワード文書 As Object
    フォルダパス = "C:\A"
    ファイル名 = "サンプル.doc"
    フルパス = フォルダパス & "\" & ファイル名
    Set ワード文書 = GetObject(フルパス)
    Application.WindowState = xlMinimized
    ワード文書.Application.Visible = True
'
    MsgBox "文書を確認してください。"
    Set ワード文書 = Nothing
End Sub
'=========================================================================================