言語・開発環境

ExcelのVBA

WSH・VBScript

関連ニュース

  • Rubberduck
    • Rubberduck is a COM add-in for the VBA IDE (VBE).
  • Visual Basicの200X年問題 2007.8.10
    • 2005年:VBメインストリームサポート終了
    • 2008年:VB延長サポート終了 ←VB6での開発がサポートなしの状態になる
    • 2009年:WindowsXPのメインストリームサポート終了
    • 2010年:Windows 2003 Serverメインストリームサポート終了
    • 2014年:WindowsXPの延長サポート終了
    • 2015年:Windows 2003 Server延長サポート終了
    • 2018年頃:Vista/Server 2008の延長サポート終了 ←VB6アプリが本当に使えなくなるのはココ
  • 開発者によるVBの利用が急減 2006.11.29
    • 北米の開発者430人以上を対象に調査を実施したこところ,昨年の春と比べVisual Basic系を使用する開発者が35%減少したという。
    • Visual Basic 6.0以前のユーザーが減少しているほか,Visual Basic .NETを使用する開発者も26%減少した。
    • 現在,最も利用率が高いのはJava(45%)で,以下C/C++(40%)とC#(32%)が続く。

ファイルの存在確認

  • 参照:http://atomsware.co.jp/cima/archives/2005/09/vb_1.html
    Private Function FileExist(sFileName As Variant) As Boolean
       Dim fso As Object
       Set fso = CreateObject("Scripting.FileSystemObject")
       FileExist = fso.FileExists(sFileName)
       Set fso = Nothing
    End Function
    • Microsoft Scripting Runtime (scrrun.dll)を参照するとよい

フルパスの文字列からファイル名とパスを別々に切り出す

  • 参照で Microsoft Scripting Runtime を参照する
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject 
    fnam = fso.GetFileName(fullpath)
    path = fso.GetParentFolderName(fullpath)

VBでハッシュテーブル

  • http://ziomatrix18.blog68.fc2.com/blog-entry-502.html
  • 参照設定で「Microsoft Scripting Runtime」にチェックを入れる。
       Dim hash As Scripting.Dictionary
       Set hash = New Scripting.Dictionary
    
       If hash.Exists("Key1") Then
           hash.Item("Key1") = "Item1"
       Else
           hash.Add "Key1", "Item1"
       End If
    
       MsgBox hash.Item("Key1")
    
       hash.RemoveAll
       Set hash = Nothing
  • 注意点:このハッシュテーブルにはなんでも入れられるわけではない。例えば構造体の配列などはセットできない

文字列操作

  • VBの文字列操作
    chr      キャラクタコードの文字を返す
     asc      文字のキャラクタコードを返す
     str      数値を文字列に変換
     val      文字列を数値に変換
     space    n 個の空白を生成
     string   特定文字を n 個生成
     trim     左右の全角半角空白を削除
     ltrim    左側の全角半角空白を削除
     rtrim    右側の全角半角空白を削除
     lcase    小文字に変換
     ucase    大文字に変換
     left     左側より n 個の文字列を切り出し
     mid      n 番目から n 個の文字列を切り出し
     mid      ステートメントして使用すると文字列を置き換える
     right    右側より n 個の文字列を切り出し
     len      何文字あるか数える
     instr    指定文字列が何番目から存在するか調べる
     format   書式指定変換をする
     now      format と組み合わせて、today などを生成する

配列のソート

  • http://www.geocities.co.jp/SilkRoad/4511/vb/strsort.htm
  • VBには簡単なソートの仕組みは用意されてないので自分でソートアルゴリズムを実装する必要がある
    Public Sub StrSort _
        (ByRef strArray() As String, _
         ByVal lngStart As Long, _
         ByVal lngEnd As Long, _
         Optional ByVal lngCompare As Long)
    
     Dim lngBaseNumber As Long                                          '中央の要素番号を格納する変数
     Dim strBaseValue As String                                         '基準値を格納する変数
     Dim lngCounter As Long                                             '格納位置カウンタ
     Dim strBuffer As String                                            '値をスワップするための作業域
     Dim i As Long                                                      'ループカウンタ
     
        If lngStart >= lngEnd Then Exit Sub                             '終了番号が開始番号以下の場合、プロシージャを抜ける
        lngBaseNumber = (lngStart + lngEnd) \ 2                         '中央の要素番号を求める
        strBaseValue = strArray(lngBaseNumber)                          '中央の値を基準値とする
        strArray(lngBaseNumber) = strArray(lngStart)                    '中央の要素に開始番号の値を格納
        lngCounter = lngStart                                           '格納位置カウンタを開始番号と同じにする
        For i = (lngStart + 1) To lngEnd Step 1                         '開始番号の次の要素から終了番号までループ
            If StrComp(strArray(i), strBaseValue, lngCompare) = -1 Then '値が基準値より小さい場合
                lngCounter = lngCounter + 1                             '格納位置カウンタをインクリメント
                strBuffer = strArray(lngCounter)                        'strArray(i) と strArray(lngCounter) の値をスワップ
                strArray(lngCounter) = strArray(i)
                strArray(i) = strBuffer
            End If
        Next i
        strArray(lngStart) = strArray(lngCounter)                       'strArray(lngCounter) を開始番号の値にする
        strArray(lngCounter) = strBaseValue                             '基準値を strArray(lngCounter) に格納
        Call StrSort(strArray(), lngStart, lngCounter - 1)              '分割された配列をクイックソート(再帰)
        Call StrSort(strArray(), lngCounter + 1, lngEnd)                '分割された配列をクイックソート(再帰)
    
    End Sub

指定フォルダ内のファイル名列挙

   'ファイル名列挙
   Dim Path As String
   Path = folder & "\" & "*.*"
   Dim fname As String
   fname = Dir(path)
   Dim fnames() As String
   Dim i As Integer
   i = 0
   Do While fname <> ""
       ReDim Preserve fnames(i)
       
       fnames(i) = fname
       
       i = i + 1
       fname = Dir()
   Loop

他プロセスの同期的実行

Option Explicit

'プロセス処理用の宣言とか
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long,  ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long,  ByVal dwMilliseconds As Long) As Long
Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

Public Const SYNCHRONIZE As Long = &H100000
Public Const PROCESS_QUERY_INFORMATION As Long = &H400
Public Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Public Const PROCESS_ALL_ACCESS As Long = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF

Type PROCESS_INFORMATION
       hProcess As Long
       hThread As Long
       dwProcessId As Long
       dwThreadId As Long
End Type

Type STARTUPINFO
       cb As Long
       lpReserved As String
       lpDesktop As String
       lpTitle As String
       dwX As Long
       dwY As Long
       dwXSize As Long
       dwYSize As Long
       dwXCountChars As Long
       dwYCountChars As Long
       dwFillAttribute As Long
       dwFlags As Long
       wShowWindow As Integer
       cbReserved2 As Integer
       lpReserved2 As Byte
       hStdInput As Long
       hStdOutput As Long
       hStdError As Long
End Type

Public Const NORMAL_PRIORITY_CLASS = &H20

Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" ( _
   ByVal lpApplicationName As String, ByVal lpCommandLine As String, _
   lpProcessAttributes As Any, lpThreadAttributes As Any, _
   ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
   lpEnvironment As Any, ByVal lpCurrentDriectory As String, _
   lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION)  As Long


Public Function Execute(cmd As String) As Integer
   
   Dim pInfo As PROCESS_INFORMATION
   Dim sInfo As STARTUPINFO
   Dim lngRet As Long
   Dim ecode As Long

   sInfo.cb = LenB(sInfo)

   lngRet = CreateProcess(vbNullString, _
       cmd, _
       ByVal 0&, _
       ByVal 0&, _
       1&, _
       NORMAL_PRIORITY_CLASS, _
       ByVal 0&, _
       vbNullString, _
       sInfo, _
       pInfo)

   WaitForSingleObject pInfo.hProcess, 100000

   GetExitCodeProcess pInfo.hProcess, ecode  ' 終了コード取得
   CloseHandle pInfo.hThread ' スレッドハンドルを閉じる
   CloseHandle pInfo.hProcess ' プロセスハンドルを閉じる

End Function

コントロールのフォントの異常?

  • 文字をMS Pゴシック サイズ9で作成したコントロールがExeにすると使用環境によって文字化けします
    • パソコンにログインだとOKだけど、ドメインでログインでアウトみたいな…)
  • で、その状態でソースをいじるとWindowsまで落ちます
  • 対処方法は、MS UIゴシックに変更したら治りました
  • (しかし本当にこんな基本的なバグがあるのか?何らかの特定環境だけでは?)

Round関数は四捨五入ではない

  • http://code.nanigac.com/source/view/74
    VB6において、丸め関数は"INT","FIX","ROUND"があります。
    このうち、"ROUND"は「最も近い偶数に丸める」という四捨五入であり、
    一般的なものとは違います(よく嵌るワナ)。
    多くの Round() 関数の挙動もこの IEEE 754 に則った「偶数丸め」です。 

VistaでのVB6対応

  • Vista でもVB6ランタイムは、提供される。
  • また、IDEも動作させることができる(ようにする)。
  • ただし、MSDEは未サポート。
  • そのため、MSDEで実行しているアプリケーションは、SQL Server 2005 Expressに移行する必要がある。

VBからVB.NETへの移行

特殊なディレクトリの取得

  • My Documents やデスクトップなど、特殊フォルダの物理的フルパスを取得するための関数です。
  • Windows2000 などでは、ユーザー毎にシステムフォルダのパスが異なったりするので、
  • 勝手に "C:\My Documents" などと決めず、この関数を用いて取得しましょう。
  • なお、Windows フォルダや System フォルダを取得したい場合はこちらを参照してください。
  • 標準モジュールに記述します。
    Option Explicit
    
    OS が管理する特殊フォルダのItemIDListのポインタを取得する
    Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, ppidl As Long) As Long 
    
    ItemIDList のポインタからフォルダの名前を取得する
    Private Declare Function SHGetPathFromIDList Lib "Shell32" _
    (ByVal pidl As Long, ByVal pszPath As String) As Long
    
    タスクメモリブロックを解放する
    Private Declare Sub CoTaskMemFree Lib "Ole32" (ByVal pv As Long)
    
    ID の値
    Public Enum IDL_LIST
       CSIDL_DESKTOP = &H0                     '\デスクトップフォルダ
       CSIDL_PROGRAMS = &H2                    '\プログラムグループ
       CSIDL_PERSONAL = &H5                    '\My Doucutents
       CSIDL_FAVORITES = &H6                   '\お気に入り
       CSIDL_STARTUP = &H7                     '\スタートアップ
       CSIDL_RECENT = &H8                      '\最近使ったファイル
       CSIDL_SENDTO = &H9                      '\送る
       CSIDL_STARTMENU = &HB                   '\スタートメニュー
       CSIDL_DESKTOPDIRECTORY = &H10           '\デスクトップディレクトリ
       CSIDL_NETHOOD = &H13                    '\NetHood
       CSIDL_FONTS = &H14                      '\フォント
       CSIDL_TEMPLATES = &H15                  '\テンプレート
       CSIDL_COMMON_STARTMENU = &H16           '\All User スタートメニュー
       CSIDL_COMMON_PROGRAMS = &H17            '\All User プログラムグループ
       CSIDL_COMMON_STARTUP = &H18             '\All User スタートアップ
       CSIDL_COMMON_DESKTOPDIRECTORY = &H19    '\All User デスクトップ
       CSIDL_APPDATA = &H1A                    '\アプリ定義データ用共通フォルダ
       CSIDL_PRINTHOOD = &H1B                  '\プリンタリンク
       CSIDL_COMMON_FAVORITES = &H1F           '\All User お気に入り
       CSIDL_INTERNET_CACHE = &H20             '\IEのキャッシュ
       CSIDL_COOKIES = &H21                    '\クッキー用フォルダ
       CSIDL_HISTORY = &H22                    '\IEの履歴
       CSIDL_INTERNET = &H1                    'Virtual folder representing the Internet.
       CSIDL_CONTROLS = &H3                    'Virtual folder containing icons for the Control Panel applications.
       CSIDL_PRINTERS = &H4                    'Virtual folder containing installed printers.
       CSIDL_BITBUCKET = &HA                   'Virtual folder containing the objects in the user's Recycle Bin.
       CSIDL_DRIVES = &H11                     'My Computer - virtual folder containing everything on the local computer:
                                               'storage devices, printers, and Control Panel.
                                               'The folder may also contain mapped network drives.
       CSIDL_NETWORK = &H12                    'Network Neighborhood - virtual folder representing
                                               'the root of the network namespace hierarchy.
       CSIDL_ALTSTARTUP = &H1D                 'File system directory that corresponds to the user's nonlocalized Startup program group.
       CSIDL_COMMON_ALTSTARTUP = &H1E          'File system directory that corresponds to the nonlocalized Startup program group
                                                'for all users. Valid only for Windows NT(R) systems.
    End Enum
    
    Private Const MAX_PATH = 260
    
    Public Function GetSPFolderPath(ItemID As IDL_LIST) As String
    '機能
    '   特殊フォルダのフルパスを取得します
    '引数
    '   ItemID : 特殊フォルダを表す ID (インテリセンスが機能します)
    '戻り値
    '   特殊フォルダのフルパス名(文字列)
    
       Dim lngRet As Long      'API からの戻り値
       Dim pidlFolder As Long  'ItemIDList のポインタ ( pidl )
       Dim strBuf As String    '文字列を受け取るバッファ
    
       'pidl 取得
       lngRet = SHGetSpecialFolderLocation(0, ItemID, pidlFolder)
    
       If lngRet >= 0 Then
           '文字列のバッファ確保
           strBuf = String$(MAX_PATH, vbNullChar)
    
           'pidl からフルパス取得
           If SHGetPathFromIDList(pidlFolder, strBuf) <> 0 Then
               '余った部分の不要なヌル文字を除去
               strBuf = Left$(strBuf, InStr(strBuf, vbNullChar) - 1)
           Else
               '取得に失敗した場合は空文字を返す
               strBuf = ""
           End If
           '後始末
           CoTaskMemFree pidlFolder
    
           GetSPFolderPath = strBuf
       End If
    
    End Function
  • 実行例:
    • イミディエイトウィンドウでの実行例です。
      ?GetSPFolderPath(CSIDL_PERSONAL)
      C:\Documents and Settings\lionel\My Documents

Format関数で西暦→和暦に変換するには

  • Format("20060101", "GGGEE") のようにする

Format関数の日付/時刻表示書式指定文字

記号意味
(:)時刻の区切り記号です。オペレーティング システムの国別情報の設定によっては、時刻の区切り記号として他の記号が使用されることがあります。時刻を時間、分、および秒で区切ることができます。変換後の時刻の区切り記号は、コントロール パネルの設定によって決まります。
(/)日付の区切り記号です。オペレーティング システムの国別情報の設定によっては、他の記号が使用されることがあります。日付を年、月、および日で区切ることができます。変換後の区切り記号は、コントロール パネルの設定によって決まります。
cddddd および t t t t t の書式で表した日付と時刻を、日付、時刻の順序で返します。指定された値に小数部がない場合は日付のみ、整数部がない場合は時刻のみを表す文字列を返します。
d日付を返します。1 桁の場合、先頭に 0 が付きません (1 〜 31)。
dd日付を返します。1 桁の場合、先頭に 0 が付きます (01 〜 31)。
ddd曜日を英語 (省略形) で返します (Sun 〜 Sat)。
aaa曜日を日本語 (省略形) で返します (日〜土)。
dddd曜日を英語で返します (Sunday 〜 Saturday)。
aaaa曜日を日本語で返します (日曜日〜土曜日)。
ddddd年、月、日を含む短い形式 (コントロール パネルで設定) で表した日付を返します。既定の短い日付形式は、m/d/yy です。
dddddd年、月、日を含む長い形式 (コントロール パネルで設定) で表した日付を返します。既定の長い日付形式は mmmm dd, yyyy です。
w曜日を表す数値を返します (日曜日が 1、土曜日が 7 となります)。
wwその日が一年のうちで何週目に当たるかを表す数値を返します (1 〜 54)。
m月を表す数値を返します。1 桁の場合、先頭に 0 が付きません (1 〜 12)。ただし、h や hh の直後に m を指定した場合、月ではなく分と解釈されます。
mm月を表す数値を返します。1 桁の場合、先頭に 0 が付きます (01 〜 12)。ただし、h や hh の直後に mm を指定した場合、月ではなく分と解釈されます。
mmm月の名前を英語 (省略形) の文字列に変換して返します (Jan 〜 Dec)。
mmmm月の名前を英語で返します (January 〜 December)。
oooo月の名前を日本語で返します (1 月 〜 12 月)。
q1 年のうちで何番目の四半期に当たるかを表す数値を返します (1 〜 4)。
g年号の頭文字を返します (M、T、S、H)。
gg年号の先頭の 1 文字を漢字で返します (明、大、昭、平)。
ggg年号を返します (明治、大正、昭和、平成)。
e年号に基づく和暦の年を返します。1 桁の場合、先頭に 0 が付きません。
ee年号に基づく和暦の年を 2 桁の数値を使って返します。1 桁の場合、先頭に 0 が付きます。
y1 年のうちで何日目に当たるかを数値で返します (1 〜 366)。
yy西暦の年を下 2 桁の数値で返します (00 〜 99)。
yyyy西暦の年を 4 桁の数値で返します (100 〜 9999)。
h時間を返します。1 桁の場合、先頭に 0 が付きません (0 〜 23)。
hh時間を返します。1 桁の場合、先頭に 0 が付きます (00 〜 23)。
n分を返します。1 桁の場合、先頭に 0 が付きません (0 〜 59)。
nn分を返します。1 桁の場合、先頭に 0 が付きます (00 〜 59)。
s秒を返します。1 桁の場合、先頭に 0 が付きません (0 〜 59)。
ss秒を返します。1 桁の場合、先頭に 0 が付きます (00 〜 59)。
tt t t t コントロール パネルで設定されている形式で時刻を返します。先頭に 0 を付けるオプションが選択されていて、時刻が午前または午後 10 時以前の場合、先頭に 0 が付きます。既定の形式は、h:mm:ss です。
AM/PM時刻が正午以前の場合は大文字で AM を返し、正午〜午後 11 時 59 分の間は大文字で PM を返します。
am/pm時刻が正午以前の場合は小文字で am を返し、正午〜午後 11 時 59 分の間は小文字で pm を返します。
A/P時刻が正午以前の場合は大文字で A を返し、正午〜午後 11 時 59 分の間は大文字で P を返します。
a/p時刻が正午以前の場合は小文字で a を返し、正午〜午後 11 時 59 分の間は小文字で p を返します。
AMPM"12 時間制" が選択されていて、時刻が正午以前の場合は午前を表すリテラル文字列を、正午〜午後 11 時 59 分の間は午後を表すリテラル文字列を返します。これらの文字列の設定および "12 時間制" の選択は、コントロール パネルで行います。AMPM は大文字、小文字のどちらでも指定できます。既定の形式は、AM/PM です。

VBでの構造体の書き方

  • 最近VB使ってないので意外と忘れてしまうためメモ
    Public Type Character
       Name As String
       Hp As Byte
       Mp As Byte
       Level As Byte
       Exp As Byte
       Gold As Byte
    End Type

VBでフォームの表示とクローズ

  • しばらく使ってないとこんな基本も忘れてしまう…
  • 表示は
    Dim f As New XxxForm
    f.Show(vbModal)
  • Closeは
    Call Unload(Me)
    Callをつけないと引数が値渡しとみなされてエラーになるので注意

VBの割り算での注意点

  • VBでは割り算の演算子は / と \ の2種類ある。/の場合、Integerなどの整数を割り算しても結果の少数以下の値は四捨五入になる。C言語と同じつもりで使っていると意外とこれに気づかずハマる。切り捨てて欲しいときは/ではなく\を使うか、もしくはint(a/b)などとする。
  • ExcelのVBAでの検証プログラム↓これだとa=128以後はbの値が切り上げられて1になる
    Sub test()
    
      Dim a As Integer
      Dim b As Integer
    
      For a = 1 To 256
          b = a / 256
          ActiveSheet.Cells(a, 1) = b
          ActiveSheet.Cells(a, 1).Select
    
          DoEvents
      Next
    
    End Sub

VBで基数変換

VBで正規表現

  • Microsoft Visual Basic 6.0 で正規表現を使用する方法 2014.4.9
    [プロジェクト] メニューの [参照設定] をクリックします。
    [Microsoft VBScript Regular Expressions 5.5] をダブルクリックし、[OK] をクリックします。
    ツールボックスの [CommandButton] をダブルクリックします。
    
    デフォルトで Command1 がフォームに追加されます。
    [Command1] をダブルクリックして、コード ウィンドウを開きます。
    次のコードを Command1_Click イベント ハンドラに貼り付けます。
    
    MsgBox(TestRegExp("is.", "IS1 is2 IS3 is4"))
    
    注 : この例では、「is.」というパターンが「IS1 is2 IS3 is4」という文字列内にある
    かどうかが判定されます。特殊文字の ピリオド (.) はワイルドカード文字として
    使用できるため、任意の 1 文字と一致し、検索パターンと一緒に表示されます。 
    ピリオド (.) を 2 つ検索パターンに追加した場合は、任意の 2 文字が表示されます。
    ピリオド (.) を使用しない場合は、 検索パターンのみが表示されます。 
    次の関数を Command1_Click イベン ト ハンドラの後に追加します。
    
    Function TestRegExp(myPattern As String, myString As String)
       'Create objects.
       Dim objRegExp As RegExp
       Dim objMatch As Match
       Dim colMatches   As MatchCollection
       Dim RetStr As String
       
       ' Create a regular expression object.
       Set objRegExp = New RegExp
    
       'Set the pattern by using the Pattern property.
       objRegExp.Pattern = myPattern
    
       ' Set Case Insensitivity.
       objRegExp.IgnoreCase = True
    
       'Set global applicability.
       objRegExp.Global = True
    
       'Test whether the String can be compared.
       If (objRegExp.Test(myString) = True) Then
    
       'Get the matches.
        Set colMatches = objRegExp.Execute(myString)   ' Execute search.
    
        For Each objMatch In colMatches   ' Iterate Matches collection.
          RetStr = RetStr & "Match found at position "
          RetStr = RetStr & objMatch.FirstIndex & ". Match Value is '"
          RetStr = RetStr & objMatch.Value & "'." & vbCrLf
        Next
       Else
        RetStr = "String Matching Failed"
       End If
       TestRegExp = RetStr
    End Function
    
    [実行] メニューの [開始] をクリックして、アプリケーションを実行します。
    [Command1] をクリックします。

トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2020-07-15 (水) 22:53:46 (465d)