なにげにぷろぐらまーWiki

Private Const CONST_VAL_0 = 10
Public Const CONST_VAL_1 = 20	' Public 定数は宣言できないっぽい。エラーになる。

Const CONST_STR As String = "文字列定数"

Public Enum ParamType
    None = 0
    TypeInt = 1
    TypeStr = 2
End Enum

Dim myVar As Variant
Debug.Print VarType(myVar)   '--> 0（定数vbEmpty）と表示される
Debug.Print TypeName(myVar)  '--> Empty　と表示される
Debug.Print IsEmpty(myVar)   '--> True　と表示される

Dim myVar As Variant                    '初期値はEmpty
If myVar = 0 Then Debug.Print "True"    '--> True　と表示される
If myVar = "" Then Debug.Print "True"   '--> True　と表示される

Dim myVar As Variant        '初期値はEmpty
myVar = Null                'Nullを代入
Debug.Print VarType(myVar)  '--> 1（定数vbNull）と表示される
Debug.Print TypeName(myVar) '--> Null　と表示される
Debug.Print IsNull(myVar)   '--> True　と表示される

If myObj Is Nothing Then
    Set myObj = Forms![フォーム1]
End If

Type Point
    x As Long
    y As Long
End Type

Sub Test()
	Dim str As String
	str = "text"
	Call SubTest(str)
End Sub

Sub SubText(str As String)
	MsgBox "テキスト : " + str
End Sub

Sub Test()
	Dim v As Integer
	v = FuncAdd(10, 20)
End Sub

Function FuncAdd(a As Integer, b As Integer) As Integer
	FuncAdd = a + b		' 計算結果を返す
End Function

Sub Test()
	Dim str As String
	str = "text"
	Call Func(str)
End Sub

Sub Func(ByVal a As String)
   a = "suzuki"         ' 受け取った値を書き換える
End Sub

Sub TestFunc(textBox As MSForms.textBox)
    textBox.Text = "text"
End Sub

Dim a As String
Dim v As Integer
a = "123"
v = val(a)

Dim a As Integer
Dim t As String
a = 123
t = str(a)

If ActiveCell.Value = "text" Then
	MsgBox "等しい"
Else
	MsgBox "等しくない"
End If

If ActiveCell.Value <> "text" Then
	MsgBox "等しくない"
Else
	MsgBox "等しい"
End If

If InStr(ActiveCell.Value, "text") > 0 Then
	MsgBox "含まれている"
Else
	MsgBox "含まれていない"
End If

' abc, xyz の間に任意の文字列が入ってもOK
If ActiveCell.Value Like "abc*xyz" Then	'

' 1〜5で始まる文字列
If ActiveCell.Value Like "[1-5]*" Then

' 都道府県名のうち、北海道、東京都、神奈川県、和歌山県、鹿児島県 以外がtrueになる
If Not c.Value Like "??[県府]" Then

' kernel32.dllのGetTickCount()を使えるようにする
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub test()
  MsgBox GetTickCount
End Sub

Dim list As Collection
Set list = New Collection

' listに要素を追加する
Dim col As Integer
col = 1
Do While ActiveSheet.Cells(1, col) <> ""
	list.Add ActiveSheet.CelllS(1, col)
	col = col + 1
Loop

' リストの要素を順に処理する
Dim str As String
str = ""
For Each v In list
	str = str & v.Value
Next

Dim dict As Scripting.Dictionary
Set dict = CreateObject("Scripting.Dictionary")

dict.Add "A1", ActiveSheet.Cells("A1")
dict.Add "A2", ActiveSheet.Cells("A2")
dict.Add "A3", ActiveSheet.Cells("A3")

Dim key As Variant
For Each key In dict.Keys
	Debug.Print key, dict(key).Value
Next

Dim r As Range
Set r = ActiveSheet.Range(Cells(1, 1), Cells(3, 3))	' 3x3 を選択
r.Offset(1,1).Select ' 3x3の範囲を行、列方向に+1移動した範囲が選択される

Dim r As Range
Set r = ActiveSheet.Range(Cells(1, 1), Cells(3, 3))	' 3x3 を選択
r(1,1).Select ' 3x3の左上1セルを選択
r(0,0).Select ' 3x3の左上からさらに1行1列左上のセルを選択

Sub Test()
	' 現在のActiveSheetに対して操作
	Range(Cells(1,1), Cells(3,3)).Select	' 選択する
End Sub

Sub Test()
	' 現在のActiveSheetに対して操作
	Range(Cells(1,1), Cells(3,3)).ColumnWidth = 5	' ポイント指定
	Range(Cells(1,1), Cells(3,3)).RowHeight = 5		' ポイント指定
	' 同じポイント数でも、セルの形状が正方形になるとは限らない。
	' 環境によって縦横比が違う。
End Sub

Sub Test()
	' ColumnWidthをセットした後、そのセルのWidthをRowHeightにセットすると、正方形になる？
	Range(Cells(1, 1), Cells(3, 3)).ColumnWidth = cellSize
	Range(Cells(1, 1), Cells(3, 3)).RowHeight = Cells(1, 1).Width
End Sub

'A1セルを基準にして最終列を求める
Set rangeEnd = ActiveSheet.Range("A1").SpecialCells(xlLastCell)

Dim rangeS As Range
Set rangeS = ActiveSheet.Cells.Find("検索したい文字列", 
                                    LookIn:=xlValues, 
                                    LookAt:=xlWhole, 
                                    SearchOrder:=xlByRows, 
                                    MatchCase:=True, 
                                    MatchByte:=True)

Range("A1").End(xlDown)   ' 下方向にセルの値の有り/無しが切り替わる直前まで検索
Range("A1").End(xlRight)  ' 右方向にセルの値の有り/無しが切り替わる直前まで検索

Range("C3").CurrentRegion.Select

Private Sub TextBox1_Change()
    If Len(TextBox1.Text) = 0 Then
        Exit Sub
    End If
    
    ' 一番右の文字が数値であれば何もしない
    If IsNumeric(Right(TextBox1.Text, 1)) = True Then
        Exit Sub
    End If
    
    ' 数値でなかった場合、その一文字を削る
    TextBox1.Text = Left(TextBox1.Text, Len(TextBox1.Text) - 1)
End Sub

• 参考サイト

UserForm1.Show vbModeless

• 参考サイト

ActiveCell.Address

' 2次元座標構造体
Private Type POINT
    x As Long
    y As Long
End Type

' API宣言
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT) As Long

' フォームのMouseMoveイベント
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim p As POINT
    Dim msg As String
    
    ret = GetCursorPos(p)
    msg = "(" & p.x & "," & p.y & ") - (" & x & "," & y & ")"
    LabelMousePos.Caption = msg
End Sub

• 参考サイト

Private Sub DrawBorder(r As Range)
    With r
    	' 実線
        .Borders(xlEdgeTop).LineStyle = xlContinuous		' 選択範囲の上辺
        .Borders(xlEdgeBottom).LineStyle = xlContinuous		' 選択範囲の下辺
        .Borders(xlEdgeRight).LineStyle = xlContinuous		' 選択範囲の右辺
        .Borders(xlEdgeLeft).LineStyle = xlContinuous		' 選択範囲の左辺
        ' 太線
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeLeft).Weight = xlMedium
    End With
End Sub

Dim r As Range ' 名前定義に登録したいセル範囲
ActiveWorkbook.Names.Add Name:="名前", RefersTo:=r

Dim r As Range ' 入力規則を設定したいセル範囲
With r.Validation
    ' 設定済みの入力規則を削除する
    .Delete
    
    ' 設定
    .Add Type:=xlValidateList,      ' リストからの値を設定
         Formula1:="=定義した名前"  ' 名前定義からの指定。セル範囲等の指定も可能。
End With

• セル範囲は複数行、複数列ではダメ。単一の列、行である必要がある。

Private v0 As Integer
Private v1 As Integer

Public Sub SetParam(a As Integer, b As Integer)
    v0 = a
    v1 = b
End Sub

Public Sub Output()
    MsgBox "add : " & (v0 + v1) & vbCrLf & "sub : " & (v0 - v1)
End Sub

Dim testClass As TestClass
Set testClass = new TestClass

Call testClass.SetParam(10, 20)
Call testClass.Output

    Dim wsh, exec As Object
    Set wsh = CreateObject("WScript.Shell")
    
    Dim command As String
    command = "dir /B"
    Set exec = wsh.exec("%ComSpec% /c " + command)
    
    Dim items As Variant
    Dim count As Integer
    count = 0
    
    ' 実行結果を1行ずつ読み込んでセルに出力する
    Dim lineStr As String
    Do Until exec.StdOut.AtEndOfStream
        lineStr = exec.StdOut.ReadLine
        ActiveSheet.Cells(count + 1, 1).value = lineStr
        count = count + 1
    Loop
    
    Set exec = Nothing
    Set wsh = Nothing

Private Declare Sub Sleep Lib "kernel32" (ByVal waitTime As Long)	' WindowsAPIの宣言。ソース先頭の方で宣言しておく

    Dim wsh, exec As Object
    Set wsh = CreateObject("WScript.Shell")
	
    Dim command As String
    command = "ipconfig"
    Set exec = wsh.exec("%ComSpec% /c " + command)
    
    ' 外部プログラムが終了するまでループする
    Do Until exec.Status
      Sleep 10
    Loop
    
    ' 標準出力をまとめて取得する
    result = exec.StdOut.ReadAll
    
    Set exec = Nothing
    Set wsh = Nothing