VBAサンプル - ミチシルベ @ wiki

既に世の中にはわかりやすくて、見やすいVBAサイトがいっぱいありますので、
まずはそちらを参照してみてください。
参考サイトはこちら

---

ブック名取得

シートのセルに記述すると、自ブック名を表示してくれます。
設計書や試験の検証物など、ブック名を記載するものはこれにしておくと、
名前が変更になっても修正作業は発生しないのでらくちん☆

=MID(CELL("filename",A1),FIND("[",CELL("filename",A1))+1,
FIND("]",CELL("filename",A1))-FIND("[",CELL("filename",A1))-1)

---

シート名取得

上と同じく。名前が変わるたびに直すのがめんどうな人向き！

=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,
LEN(CELL("filename",A1))-FIND("]",CELL("filename",A1)))

---

VBAで他のファイルを開く

'************************************************************
' ファイルをオープンする
' 【引数】filePath：対象ファイルのフルパス
'         fileName：対象ファイルのファイル名
'************************************************************
Private Sub fileOpen(filePath As String, fileName As String)
   Workbooks.Open filePath
   Workbooks(fileName).Activate
End Sub

---

VBAで他のファイルを複製（コピペ）する

'************************************************************
' ファイルをコピーする
' 【引数】oldFilePath：複製元のファイル名
'         newFileName：複製して生成されるファイル名
'************************************************************
Private Sub fileCopy(oldFilePath As String, newFileName As String)
   Dim FSO
   Set FSO = CreateObject("Scripting.FileSystemObject")
   
   'ファイルをコピーして生成する
   FSO.CopyFile oldFilePath, newFileName

   Set FSO = Nothing
End Sub

---

VBAで罫線を引きます

'************************************************************
' 選択されている範囲に罫線を引く。
' 【引数】True ：実線で罫線を引く。
'         False：内部の横線のみ点線で罫線を引く。
'************************************************************
Private Sub drawLine(flag As Boolean)
    '罫線を引きます
    With Selection
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        If flag Then
            .Borders(xlInsideHorizontal).Weight = xlThin '実線
        Else
            .Borders(xlInsideHorizontal).Weight = xlHairline '点線
        End If
    End With
End Sub

---

シートの指定した列の、最終行を取得する

よく繰り返し条件に使います。

'************************************************************
' 最終行を取得する。
' 【引数】　String：列位置
' 【戻り値】Integer：最終行位置
'************************************************************
Private Function getLastRow(column As String) As Integer
   getLastRow = ActiveSheet.Range("$" & column & "$65536").End  (xlUp).Row
End Function

---

DB接続（Oracleで動作確認済。）

よくエラーがおきるところなので、エラー処理が入ってます。

'************************************************************
' DBをオープンする。
' 【戻り値】True ：正常終了
'           False：異常終了
'************************************************************
Private Function DbOpen() As Boolean
On Error GoTo ErrorTrap
    DbOpen = False
    'DB接続
    adoCON.Open "Provider=MSDAORA;" & "Data Source=" & TNS & ";",  USER, PASS
   
    DbOpen = True
    Exit Function
ErrorTrap:
    Dim errorMsg As String
    Dim errMsgRslt As String
    errorMsg = "エラー内容：" & Err.Description & vbCrLf & _
               "エラー番号：" & Err.Number & vbCrLf
    errMsgRslt = MsgBox(errorMsg, vbCritical, "エラーメッセージ")
End Function

---

DB切断（Oracleで動作確認済。）

ちゃんと接続を解除しないと、大変なことになりますよ！忘れずに。

'************************************************************
' DBをクローズする。
'************************************************************
Private Sub DbClose()
    'DBクローズ
     adoCON.Close
    Set adoCON = Nothing
End Sub

---

デバッグログ出力

Debug.Print "デバッグログSTART" 'イミディエイトウィンドウに出力されます。

---

正負の符号表示

ユーザ書式で右記のように設定 "+"0.00;"-"0.00

ここまで。