Sample Macro  その他 [基本型] Previous Next


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


2) スパークラインを挿入する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub スパークラインを挿入する()
    シート名 = "SSS"                            '※1
    データセル範囲 = "B2:H6"                    '※2
    配置セル範囲 = "I2:I6"                      '※3
    種類 = xlSparkLine                          '※4'折れ線
    Worksheets(シート名).Activate
    Range(配置セル範囲).SparklineGroups.Add Type:=種類, SourceData:=データセル範囲
End Sub
'--------------------------------------------------------------
Sub スパークラインをクリアする()
    シート名 = "SSS"                            '※1
    配置セル範囲 = "I2:I6"                      '※3
    Worksheets(シート名).Activate
    Range(配置セル範囲).SparklineGroups.Clear
End Sub
'=================================================================================
処理概要
※1 シート名を記述する
※2 データが入っているセル範囲を記述する
※3 スパークラインを挿入するセル範囲を記述する
※4 スパークラインの種類を指定する
   (折れ線:xlSparkLine、縦棒:xlSparkColumn、勝敗:xlSparkColumnStacked100)


3) 図形の名前・削除・複製 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 図形の名前を調べる()
    図形の名前 = ActiveSheet.Shapes(1).Name '図形の名前を調べる
End Sub
'=================================================================================
ワークシート
Sub すべての図形からテキストボックスを見つける()
Dim 図形 As Shape
    For Each 図形 In ActiveSheet.Shapes
        If Left(図形.Name, 8) = "Text Box" Then
            MsgBox 図形.Name & " が見つかりました。", , "すぐマク"
        End If
    Next
End Sub
'--------------------------------------------------------------
Sub テキストボックスを見つけてコピーする_ワークシートから()
    For Each 各図形 In Worksheets(1).Shapes
        If 各図形.Type = msoTextBox Then	'※2 図形の種類 - テキストボックス
            各図形.Copy
            Stop
        End If
    Next
End Sub

'=================================================================================
Sub オートシェイプを追加する()
    種類 = msoShapeRectangle            '※3 オートシェイプの種類 - 四角形
    左 = 40                             '※4 左端までの距離
    上 = 20                             '※4 上端  〃
    幅 = 100                            'オートシェイプの幅
    高さ = 50                           'オートシェイプの高さ
    ActiveSheet.Shapes.AddShape 種類, 左, 上, 幅, 高さ
End Sub
'--------------------------------------------------------------
Sub オートシェイプの矢印を見つけて選択する_ワークシートから()
    シート名 = "Sheet1"
    図形の種類 = msoShapeUpArrow                '※5 ブロック矢印の上矢印
    For Each 各図形 In Worksheets(シート名).Shapes
        If 各図形.AutoShapeType = 図形の種類 Then
            各図形.Select
            Stop
        End If
    Next
End Sub
'=================================================================================
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 '※6
            図形.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
'=================================================================================
※1 Shapesコレクション(Excel97以上用)は指定された文書のすべての描画レイヤのオブジェクト
   (オートシェイプ、フリーフォーム、OLE オブジェクト、ピクチャなど)
※2 図形の種類 … MsoShapeTypeクラスの定数一覧表は こちら
※3 オートシェイプの種類 … MsoAutoShapeTypeクラスの定数一覧表は こちら
※4 左上隅からオートシェイプの左端または上端までの距離(ポイント単位)
※5 オートシェイプのブロック矢印の上矢印…msoShapeUpArrow、下矢印…msoShapeDownArrow、
   左矢印…msoShapeLeftArrow、右矢印…msoShapeRightArrow
※6 引数Typeの定数msoFormControl はフォームコントロール、定数一覧表は こちら
サンプルブックのダウンロードは下記リンクをクリック
 図形を削除する (YNxv212_Shapes_delete.xls 60KB)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。


4) 画像の名前・削除・複製 (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)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。


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


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


7) Excelのバージョンを表示する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub Excelのバージョンと商品名を表示する()       'Windows用(Macintosh非対応)
    バージョン = Application.Version            'バージョン番号を取得
    Select Case Val(バージョン)
        Case Is = "16.0"
            商品名 = "2016"
        Case Is = "15.0"
            商品名 = "2013"
        Case Is = "14.0"
            商品名 = "2010"
        Case Is = "12.0"
            商品名 = "2007"
        Case Is = "11.0"
            商品名 = "2003"
        Case Is = "10.0"
            商品名 = "2002"
        Case Is = "9.0"
            商品名 = "2000"
         Case Else
            商品名 = "不明"
    End Select
    MsgBox "Excel " & 商品名 & " (V" & バージョン & ")", , "すぐマク"
End Sub
'=================================================================================
※1 Excelのバージョンは[ファイル]メニュー-[ヘルプ]から、または、[ヘルプ]メニュー-[バージョン情報]からの[Microsoft Excel のバージョン情報]ダイアログに、表示される
[Microsoft Excel のバージョン情報]ダイアログ


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



9) プロダクト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
'==========================================================
※1 プロダクトIDの表示方法は、上記[7 Excelのバージョンを表示する]
   の※1と同様


10) OSの名前を表示する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub OSの名前を表示する()
    osvsn = Application.OperatingSystem         '※1 OSのバージョン情報を取り出す
    商品名 = "不明"
    If Left(osvsn, 7) = "Windows" Then
        If Right(osvsn, 4) = "6.02" Then
            商品名 = "Windows 8"
        ElseIf Right(osvsn, 4) = "6.01" Then
            商品名 = "Windows 7"
        ElseIf Right(osvsn, 4) = "6.00" Then
            商品名 = "Windows Vista"
        ElseIf Right(osvsn, 4) = "5.01" Then
            商品名 = "Windows XP"
        ElseIf Right(osvsn, 4) = "5.00" Then
            商品名 = "Windows 2000"
        ElseIf Right(osvsn, 4) = "4.90" Then
            商品名 = "Windows Me"
        ElseIf Right(osvsn, 4) = "4.10" Then
            商品名 = "Windows 98"
        ElseIf Right(osvsn, 4) = "4.00" Then
            商品名 = "Windows 95"
        End If
    Else
        If Left(osvsn, 23) = "Macintosh (PowerPC) 10." Then
            商品名 = "Mac OS X"
        ElseIf Left(osvsn, 22) = "Macintosh (PowerPC) 9." Then
            商品名 = "Mac OS 9"
        End If
    End If
    MsgBox "名前とバージョン … " & osvsn & vbCr & "商品名 … " & 商品名, , "使用中のOS"
End Sub
メッセージボックス
'=====================================================
※1 64ビット版であっても同じ表示


11) ユーザー名・所属名を取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ユーザー名と所属名を取得する()
    ユーザー名 = Application.UserName
    所属名 = Application.OrganizationName
End Sub
'--------------------------------------------------------------------------------
使用可能なExcelのバージョン
'--------------------------------------------------------------------------------
Sub ユーザー名を取得する()
    ユーザー名 = CreateObject("WScript.Network").UserName
End Sub
'=================================================================================


12) コンピュータ名を取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub コンピュータ名を取得する_環境変数()
    名前 = "ComputerName"                        '環境変数の名前を指定
    コンピュータ名 = Environ(名前)
End Sub
'--------------------------------------------------------------------------------
Sub コンピュータ名を取得する_WSH()
    コンピュータ名 = CreateObject("WScript.Network").ComputerName
End Sub
'=================================================================================


13) 国地域に関する情報を取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 国地域に関する情報を取得する()
    Excelの国地域別バージョン番号 = Application.International(xlCountryCode)
    コントロールパネルの国地域 = Application.International(xlCountrySetting)
    通貨記号 = Application.International(xlCurrencyCode)
    小数点の記号 = Application.International(xlDecimalSeparator)
End Sub
'=================================================================================


14) VBProjectにアクセスする このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub アクティブなプロジェクトの名前を表示する()  '※1
    MsgBox Application.VBE.ActiveVBProject.Name
End Sub
'--------------------------------------------------------------------------------
Sub VisualBasicプロジェクトの名前を表示する()   '※1
    MsgBox ThisWorkbook.VBProject.Name
End Sub
'--------------------------------------------------------------------------------
Sub VisualBasicプロジェクトの名前を変更する()   '※1
    ThisWorkbook.VBProject.Name = "NewProject"  '※2
End Sub
'--------------------------------------------------------------------------------
Sub 標準モジュールをインポートする()            '※1
    Application.VBE.ActiveVBProject.VBComponents.Import "C:\Module1.bas"  '※3、※4
End Sub
'=================================================================================
※1 Excel2002でこのマクロを実行するには、[セキュリティ]ダイアログの[Visual Basic プロジェ
   クトへのアクセスを信頼する]にチェックが必要(ウィルス対策のためには危険な行為です)

※2 "NewProject"には新しい名前
※3 "C:\Module1.bas"には予めエクスポートしておいたファイルを指定する
※4 新しいブックにインポートすればモジュールを追加したことになる


15) ハイパーリンクを挿入・削除する このページのトップへ もくじへ 使用可能な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
'=================================================================================


16) ハイパーリンクの有無を調べる このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ハイパーリンクの有無を調べる()
    セル範囲 = "A1:C3"
    ハイパーリンクの数 = Range(セル範囲).Hyperlinks.Count
    If ハイパーリンクの数 = 0 Then
        MsgBox "ハイパーリンクは設定されていません。", , "すぐマク"
    Else
        MsgBox "ハイパーリンクの数は " & ハイパーリンクの数 & " です。", , "すぐマク"
    End If
End Sub
'=================================================================================


17) ハイパーリンク先のファイルを表示する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ハイパーリンク先のファイルを表示する()
    ActiveWorkbook.FollowHyperlink _
        Address:="YNxv201.html", _
        SubAddress:="#2", _
        NewWindow:=True                         '※1、2、3、4
End Sub
'=================================================================================
Sub セルに設定されているハイパーリンクを実行する()
    セル = "A1"
    Range(セル).Hyperlinks(1).Follow NewWindow:=True
End Sub
'=================================================================================
※1 引数Addressには目的の文書(html、xls、doc等)のアドレスを指定する
※2 引数SubAddressには目的の文書内の位置を指定(省略可)
※3 引数NewWindow: True=新しいウィンドウに表示(既定値はFalse)
※4 FollowHyperlinkメソッドは、既にダウンロードしてあるとキャッシュのファイルを表示


18) Wordを起動して文書を開く このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub Wordを起動して文書を開く_Set文にて()
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 Wordを起動して文書を開く_With文にて()
    フルパス = "C:\A\サンプル.doc"
    With CreateObject("Word.application")
        .Visible = True
        .Documents.Open フルパス
    End With
End Sub
'=================================================================================
Sub Wordを起動して文書を開く_読み取り専用_Set文にて()
Dim ワード As Object
Dim ワード文書 As Object
Dim フルパス As String
    フルパス = "C:\A\サンプル.doc"
    Set ワード = CreateObject("Word.Application")
    ワード.Visible = True
    Set ワード文書 = ワード.Documents.Open(Filename:=フルパス, ReadOnly:=True)
End Sub
'---------------------------------------------------------------------------------
Sub Wordを起動して文書を開く_読み取り専用_With文にて()
    フルパス = "C:\A\サンプル.doc"
    With CreateObject("Word.application")
        .Visible = True
        .Documents.Open フルパス, , True
    End With
End Sub
'=================================================================================
Sub ExcelからWord文書を開いて表示する()
Dim ワード文書 As Object
    フォルダパス = "C:\A"
    ファイル名 = "サンプル.doc"
    フルパス = フォルダパス & "\" & ファイル名
    Set ワード文書 = GetObject(フルパス)
    Application.WindowState = xlMinimized
    ワード文書.Application.Visible = True

    MsgBox "文書を確認してください。"
    Set ワード文書 = Nothing
End Sub
'=================================================================================


19) Wordを起動して文書を印刷する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub Wordを起動して文書を印刷する_With文にて()
    フルパス = "C:\A\サンプル.doc"
    With CreateObject("Word.application")
        .Visible = True
        .Documents.Open フルパス
        .ActiveDocument.PrintOut Background:=False
        .Quit
    End With
End Sub
'=================================================================================


20) OutlookでExcelブックを添付したメールを送信 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub OutlookでExcelブックを添付したメールを送信する() '※1
    宛先 = Range("B2").Value                    'メルアドをセルから取得 ※2
    CC = Range("B3").Value                      '※3
    BCC = Range("B4").Value                     '※3
    件名 = "データ送付の件"
    本文形式 = 1                                'olFormatPlain テキスト形式
    本文 = "調査データを送信します。" & vbCr & _
            "○×支店総務課"
    添付ファイル名 = ThisWorkbook.Name          '※4、5
    添付Fフルパス = ThisWorkbook.FullName       '※4、5
'
    With CreateObject("Outlook.Application")    'Outlookへの参照を作成して
        With .CreateItem(olMailItem)            '新しいOutlookアイテムについて
            .Recipients.Add(宛先).Type = 1      'olTo
            .Recipients.Add(CC).Type = 2        'olCC ※3
            .Recipients.Add(BCC).Type = 3       'olBCC ※3
            .Subject = 件名
            .BodyFormat = 本文形式
            .Body = 本文
            .Attachments.Add 添付Fフルパス, , , 添付ファイル名 '※4、5
            .Send                               '送信する
        End With
    End With
End Sub
'=================================================================================
ワークシート ※1 参照設定(Microsoft Outlook nn.n Object Library)は不要
※2 メルアドは右図のようにワークシートに入っている前提
※3 CCまたはBCCしない場合はこの行を削除する
※4 添付ファイルがない場合はこの行を削除する
※5 添付ファイルは保存されているものに限る


21) mp3ファイルを再生する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub mp3ファイルを再生する()
    フルパス = "C:\A\Kalimba.mp3"               '※1
    With CreateObject("WScript.Shell")
        .Run フルパス                           '※2
    End With
End Sub
'=================================================================================
※1 mp3ファイルへのフルパスを記入する (この例はWindows7の[サンプル ミュージック]フォルダーに
  ある「Kalimba.mp3」がCドライブの「A」フォルダーに入っている場合)
※2 mp3ファイルに関連付けられているアプリケーション (通常はWindowsMediaPlayer) が起動されて
  実行される
 


22) ダブルクリックでGoogleマップを表示する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
                                        Cancel As Boolean) '※1、※4
    住所セル = "$A$1"                           '※2
    If Target.Address = 住所セル Then
        Cancel = True                           '編集モードにしない
        Call ShowGoogleMap(Me.Range(住所セル).Value)
    End If
End Sub
'=================================================================================
Private Sub ShowGoogleMap(ByVal strAddress As String)
    If strAddress = "" Then Exit Sub
    住所 = UrlEncode(StrConv(strAddress, vbWide))   '住所をエンコードする
    SPDY_URL = "http://maps.google.co.jp/maps?f=q&hl=ja&q=" _
        & 住所 & "&z=" & "16"                       '※3
    CreateObject("WScript.Shell").Run SPDY_URL      'Google Mapを表示する
End Sub
'---------------------------------------------------------------------------------
Function UrlEncode(ByVal strText As String) As String 'URLエンコードする関数
    If strText = "" Then Exit Function
    With CreateObject("ScriptControl")
        .Language = "JScript"                       'JScript
        UrlEncode = .CodeObject.encodeURI(strText)  'encodeURI関数
    End With
 End Function
'=================================================================================
※1 Sheetモジュールに記述する (このサンプルはダブルクリックするセルが単独セルの場合)
ワークシート
※2 RowAbsoluteとColumnAbsoluteが必要
※3 Google提唱の新プロトコル「SPDY」によるURL、表示倍率:16
※4 ダブルクリックするセルが結合セルの場合は、※1のプロシージャに替えて下記のように記述する
'=================================================================================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    住所セル = "A3"
    If Not Intersect(Target, Me.Range(住所セル)) Is Nothing Then
        Cancel = True
        Call ShowGoogleMap(Me.Range(Left(Target.Address, _
            InStr(1, Target.Address, ":", vbTextCompare) - 1)).Value)
    End If
End Sub
'=================================================================================
サンプルブック … ダウンロードはこちら (YNxv212_GoogleMap.xls 63KB)
関連ページ … Googleマップを表示する


23) 郵便番号でGoogleマップを表示する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 郵便番号でGoogleマップを表示する()
    郵便番号 = "1066101"                            '※1
    SPDY_URL = "http://maps.google.co.jp/maps?f=q&hl=ja&q=" _
        & 郵便番号 & "&z=" & "16"                   '※2
    CreateObject("WScript.Shell").Run SPDY_URL      'Google Mapを表示する
End Sub
'=================================================================================
※1 郵便番号を指定する(存在しない郵便番号の場合も何等か表示される)
※2 Google提唱の新プロトコル「SPDY」によるURL、表示倍率:16


24) PDFファイルを開く このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpszOp As String, _
    ByVal lpszFile As String, ByVal lpszParams As String, _
    ByVal LpszDir As String, ByVal FsShowCmd As Long) As Long
'
Sub PDFファイルを関連付けられたアプリケーションで開く()
    PDFフルパス = "D:\A\02.pdf"                    '※1
    Call ShellExecute(0, "open", PDFフルパス, vbNullString, vbNullString, 1)
End Sub
'=================================================================================
Sub PDFファイルをアドビリーダーで開く()
    PDFフルパス = "D:\A\02.pdf"                 '※1
    Adobeフルパス = "C:\Program Files\Adobe\Reader 10.0\Reader\AcroRd32.exe " '※2
    RetVal = Shell(Adobeフルパス & " " & PDFフルパス, 3)
End Sub
'=================================================================================
Sub PDFファイルをIEで開く()
    フルパス = "D:\A\02.pdf"                    '※1
    Shell "C:\Program Files\Internet Explorer\iexplore.exe" _
        & " " & フルパス, WindowStyle:=vbNormalFocus '※2
End Sub
'=================================================================================
Sub PDFファイルをエクスプローラーの引数を指定して開く()
    フルパス = "D:\A\02.pdf"                    '※1
    Shell ("explorer.exe " & フルパス)
End Sub
'=================================================================================
Sub PDFファイルを指定して関連付けられたアプリケーションを起動する()
    PDFフルパス = "C:\A\02.pdf"                 '※1
    ウィンドウの外観 = 5                        '※3
    With CreateObject("Wscript.Shell")
        .Run PDFフルパス, ウィンドウの外観      '※3
    End With
End Sub
'=================================================================================
※1 PDFファイルへのフルパスを指定する (この例では CドライブのAフォルダーの02.pdf、
   02.pdfは国税庁ホームページからダウンロードした「申告書B」を使用している)
※2 AdbeリーダーおよびIEのインストール先はパソコンによって異なる
※3 RunメソッドのIntWindowStyle引数の値と内容 … こちら


25) PDFファイルにエクスポートする このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ワークシートの内容をPDFファイルにエクスポートする()
    フルパス = "C:\A\480.pdf"                   '※1
    ファイル形式 = xlTypePDF
    ActiveSheet.ExportAsFixedFormat Type:=ファイル形式, Filename:=フルパス '※2、3
End Sub
'=================================================================================
Sub ワークシートの内容をPDFファイルにエクスポートする_全パラメーター指定()
    フルパス = "C:\A\480.pdf"                   '※1
    ファイル形式 = xlTypePDF
    ActiveSheet.ExportAsFixedFormat Type:=ファイル形式, Filename:=フルパス, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False '※2、3
End Sub
'=================================================================================
※1 エクスポートするPDFファイルをフルパスで指定する
   (この例は CドライブのAフォルダーへ480.pdfというファイル名で)
※2 ExportAsFixedFormatメソッドのパラメーター … こちら
※3 ワークシートの背景写真や図形などエクスポートされないものがある


26) エクスプローラーを起動する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub エクスプローラーを起動する()
    Shell "explorer.exe"
End Sub
'---------------------------------------------------------------------------------
Sub エクスプローラーをフォルダーを選択した状態で起動する()
    フォルダーパス = "C:\A"                     '※1
    CreateObject("Shell.Application").Open フォルダーパス
End Sub
'---------------------------------------------------------------------------------
Sub エクスプローラーをフォルダーを選択した状態で起動する_Shell関数()
    フォルダーパス = ThisWorkbook.Path          '※1
    ウィンドウの形式 = vbNormalFocus            '※2
    タスクID = Shell("explorer.exe " & フォルダーパス, ウィンドウの形式)
End Sub
'=================================================================================
※1 (必須) ドライブを含めて指定できる
※2 (省略可能) vbNormalFocus:フォーカスを持ち元のサイズと位置に復元される、
        vbMaximizedFocus:フォーカスを持ち最大化表示される、
        他にvbHide、vbMinimizedFocus、vbNormalNoFocus、vbMinimizedNoFocusがある

Excel VBA Macro