【EXCEL VBA】セルの書式設定まとめ
’書式設定コード例
Private Sub editCell()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1") '編集するシート
ws.Cells(1,1).Font.Name = "MS Pゴシック" 'フォント種類 ws.Cells(1,1).Font.Size = 12 'フォントサイズ ws.Cells(1,1).Font.Bold = True '太字に ws.Cells(1,1).Font.Color = vbWhite 'フォントカラー （白） ws.Cells(1,1).Interior.Color = vbRed 'セルの色（赤） ws.Cells(1,1).ShrinkToFit = True '縮小して表示 ws.cells(1,1).WrapText = True '折り返して表示
set ws = Nothing
End Sub
コード例終わり。
上記の例を含むセルの書式設定あれこれです
'Font.Name フォントの種類（ＭＳ Ｐゴシックなど） 'Font.Size フォントサイズ（16など） 'Font.Bold 太字(Trueなら有り､Falseなら無し) 'Font.Color 色（RGB(255, 0, 0)、RGB(0, 255, 0)、vbRed、vbblueなど） 'Font.FontStyle 標準､太字､斜体､太字､斜体など 'Font.OutlineFont フォントのアウトライン化(Trueなら有り､Falseなら無し) 'Font.Italic 斜体(Trueなら有り､Falseなら無し) 'Font.Underline 下線（Trueなら有り、Falseなら無し） 下線 'Font.Strikethrough 取消線(Trueなら有り､Falseなら無し) 'Font.Superscript 上付き文字(Trueなら有り､Falseなら無し) 'Font.Subscript 下付き文字(Trueなら有り､Falseなら無し) 'セルのサイズに合わせた修正 ' 縮小して表示 'Range("B3").ShrinkToFit = True ' 折り返して全体を表示 'Range("B2").WrapText = True
セルの結合と解除
'Range("A1:C3").Merge True '--- A1:C1、A2:C2、A3:C3を結合
'Range("A1").UnMerge '--- A1:C3の結合を解除
などなど
AccessVBA 指定したWord Excel ppt ファイルを開いて印刷する
予め印刷したいファイルをフルパスをテーブル保存しておきます。（テーブル名/フルパス）
印刷実行時にそのテーブルを読み込み、指定したフルパスを開いて印刷実行します。
印刷実行したら、そのファイルを閉じる一連の動作です。
'-----------------------------------------------------------------------------------------------------------
Private Sub selectListName()
Dim db As Database
Dim rst As Recordset
Dim strSQL As String
Dim filename As String
Dim filetype As String
Set db = CurrentDb
strSQL = "SELECT テーブル名.* FROM テーブル名;"
Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
If rst.RecordCount <> 0 Then
If IsNull(rst!フルパス) Then
MsgBox "印刷ファイルが、指定されていません。"
Exit Sub
Else
filename = rst!フルパス
If rst!フルパス Like "*.doc*" Then
filetype = "doc"
Else
If rst!フルパス Like "*.xls*" Then
filetype = "xls"
Else
filetype = "ppt"
End If
End If
’予め登録してあるフルパスからファイル形式を推定し、印刷実行する
'printManual プロシージャにファイルタイプとフルパスを渡します
Call printManual(filetype, filename)
End If
End If
End If
db.Close
Set db = Nothing
End Sub
'印刷実行のプロシージャ
Private Sub printManual(filetype As String, filename As String)
Dim fileobject As Object
Dim xlsbook As Object
Dim pptfile As Object
Select Case filetype
Case Is = "doc"
Set fileobject = CreateObject("Word.Application")
fileobject.Documents.Open (filename)
fileobject.ActiveDocument.PrintOut
fileobject.ActiveDocument.Close
fileobject.Quit
Set fileobject = Nothing
Case Is = "xls"
Set fileobject = CreateObject("Excel.Application")
Set xlsbook = fileobject.Workbooks.Open(filename)
xlsbook.PrintOut
xlsbook.Close
fileobject.Quit
Set xlsbook = Nothing
Set fileobject = Nothing
Case Is = "ppt"
Set fileobject = CreateObject("Powerpoint.Application")
Set pptfile = fileobject.Presentations.Open(filename)
pptfile.PrintOut
pptfile.Close
fileobject.Quit
Set pptfile = Nothing
Set fileobject = Nothing
End Select
End Sub
AccessVBA CSVファイルをエクスポートしヘッダー行を削除する
EXCELにエクスポートする場合の補足です。
CSVでエクスポートして、ヘッダー行（フィールド名）を削除する仕様です。
↓EXCELへのエクスポート方法はこちら
上記で tranferspreadsheet とあるのを
CSVエクスポートの場合は、
DoCmd.TransferText acExportDelim, , "TableName", filename, 1
になります。
以下、コード記述
'---------------------------------------------------------------------------------------
Private Sub removeHeaderName
Dim xlsApp As Object
Dim xlsbook As Object
Dim xlsSheet As Object
Dim filename AS String
filename = ¥aaaaa '操作するファイルのフルパス
Set xlsApp = CreateObject("Excel.Application")
xlsApp.DisplayAlerts = False 'CSV保存の場合のメッセージを非表示に
Set xlsbook = xlsApp.Workbooks.Open(filename)
Set xlsSheet = xlsbook.worksheets(1)
With xlsSheet
'行を削除
.Rows(1).Delete
End With
'保存
xlsbook.Save
xlsApp.Application.Quit
Set xlsSheet = Nothing
Set xlsbook = Nothing
Set xlsApp = Nothing
End Sub
’-------------------------------------------------------------------------
以上、コード記述終わり
AccessVBA バーコード用コードにチェックデジットを追加する NW7
Accessレポート上で、バーコードを標準表示できますが、access2010まではチェックデジット付きのバーコードを表示することができないようです。
またNW7の場合、数字のみで構成されるコードは標準機能で表示されるものの、以下のリンク先にあるようなNW7を構成する文字列（A~C、＄など）を含むコードは上手く表示できないようです。
そこで一旦チェックデジット付きのレコードを作成し、それをバーコード表示用フォントをインストールする方法で、NW7のチェックデジット付きバーコードを表示する方法を試してみました。
※フォントインストールについて
予めM_チェックデジットというテーブルを作成しておき、そのテーブルのコード列に変換対象の文字、変換数列に対応する数値を登録しておきました。
コード(列） 0...9 - $.......
変換数（列） 0...9 10 11.....
といったイメージです。
処理を2つに分けて記述しています。
以下、VBAの記述
1つ目は表示させたいバーコード用のデータからチェックデジット用の変換数を導き出します。
'--------------------------------------------------------------------------------------------
Private Sub createModulus16()
Dim db As Database
Dim rst As Recordset
Dim rst1 As Recordset
Dim i As Integer
Dim nameLen As Integer
Dim NWcode As Integer
Dim strKZcode As String
Dim cnt As Integer
Set db = CurrentDb
'表示させたいバーコードが含まれるテーブルでCD列の内容をバーコード表示させます
'チェックデジット列にチェックデジット計算用の数値を格納します
Set rst = db.OpenRecordset("テーブル1")
'チェックデジット計算用テーブル
Set rst1 = db.OpenRecordset("M_チェックデジット")
If rst.RecordCount <> 0 Then
Do Until rst.EOF
rst.Edit
’チェックデジット計算用の数値を格納する変数
NWcode = 0
nameLen = Len(rst!CD) 'CD列の文字数をカウント
’CD列の文字を走査
For i = 1 To nameLen
rst1.MoveFirst
Do Until rst1.EOF 'チェックデジット用のテーブルを走査
If Mid(rst!CD, i, 1) = rst1!コード Then 'チェックデジット用テーブルのコード列と照合
NWcode = NWcode + rst1!変換数
Exit Do 'チェックテーブルとマッチした場合Exitで抜けて次の文字照合へ
End If
rst1.MoveNext
Loop
Next i
'スタート・ストップに「a」=16を追加
rst!チェックデジット = NWcode + 32 'チェックデジット計算用の数値を一時格納
rst.Update
rst.MoveNext
Loop
End If
End Sub
'-----------------------------------------------------------------------------------------------
以下、VBAの記述
2つ目は、チェックデジット列に格納した数値を元にチェックデジット用のコードを導き出す。
'-----------------------------------------------------------------------------------------------
Private Sub createNW7digit()
Dim db As Database
Dim rst As Recordset
Dim rst1 As Recordset
Dim i As Integer
Dim NWcode As string
Dim chckdigit As Integer
Dim strdigitNum As String
Dim cnt As Integer
Set db = CurrentDb
Set rst = db.OpenRecordset("テーブル1")
Set rst1 = db.OpenRecordset("M_チェックデジット")
If rst.RecordCount <> 0 Then
Do Until rst.EOF
rst.Edit
chckdigit = 16 - rst!チェックデジット Mod 16
If chckdigit = 16 Then
strdigitNum = "0"
Else
'算出した数値をもう一度チェックデジット用テーブルと照合してコードを導き出す
rst1.MoveFirst
Do Until rst1.EOF
If chckdigit = rst1!変換数 Then
strdigitNum = rst1!コード
Exit Do 'チェックテーブルとマッチした場合Exitで抜けて次の文字照合へ
End If
rst1.MoveNext
Loop
rst!NW7code = "a" & CD & strdigitNum & "a" 'スタートストップに「a」を追加
End If
End If
rst.Update
rst.MoveNext
Loop
db.Close
Set db = Nothing
End If
End Sub
'-----------------------------------------------------------------------------------------
以上、VBAの記述終わり。
AccessVBA フィールド内の指定文字を目印に分割する
「123456-01」といったコードなどをハイフンを境に前と後ろで分割して取得したい、
「田中 太郎」といった姓と名をスペースで区切って分割して取得したいなど、
指定した文字などを目印にそれ以降と以前で分割して別のフィールドに保存したいケースなどに使えます。
ASCIIコードの改行文字などにも対応可能です。
サンプルコードの定義は、
テーブル1：元のテーブル
Fld：分割したいフィールド
Fld1:分割後のフィールドNo1
Fld2:分割後のフィールドNo2
です。
以下、VBAの記述
'---------------------------------------------------------------------------------------------
Dim db As Database
Dim rst As Recordset
Dim i As Integer 'フィールド内の分割数をカウント
Dim strArray() As String 'Fld内を分割したものを格納する配列
Set db = CurrentDb
Set rst = db.OpenRecordset("テーブル1")
If rst.RecordCount <> 0 then
Do until rst.EOF
rst.Edit
If IsNull(rst!Fld) Or Len(trim(rst!Fld)) = 0 then
i=0
else
strArray = Split(rst!Fld,"-")
'Split関数で指定した文字(カッコ内の""で囲った部分）等でFld内のテキストを分割する
'例えばASCIIコードの改行文字なら Split(rst!Fld,Chr(10))
i=Ubound(strArray,1)+1
'Ubound関数で配列数をカウント
End If
Select Case i
Case Is = 1
rst!Fld1 = strArray(0)
Case Is >=2
rst!Fld1 = strArray(0)
rst!Fld2= strArray(1)
'分割するフィールド数に応じてCaseを追加する。例では2つ。
End Select
rst.Update
rst.MoveNext
Loop
db.Close
Set db = Nothing
'--------------------------------------------------------------------------------------------------
以上、VBAの記述終わり。
個人的には予めMAXの分割数を決まっていて、それに対応して分割した内容を格納するケースばかりです。（つまり上限数以上に分割される場合は、フィールドの先頭から数えて上限以降の内容は格納してません）
分割数が予め決まっていない、分割可能な全データを各々フィールドを作成して格納したい場合には、
1)全レコードの分割数を一旦カウントして、最大の分割数を取得
2)最大の分割數に応じてフィールドを作成
でイケそうな気がします・・・？
その場合はSelectではなく、For文を使う感じになるでしょうか。。。
Dim j As Integer
Dim strFld as String
i=Ubound(strArray,1)
strFld = "Fld"
For j=0 to i
rst(strFld & j) = strArray(j)
rst!(Fld(j))=strArray(j)
Next i
※一旦フィールド名（Fld）を変数に代入して呼び出すレコードセットを括弧でくくって変数＆添字にする修正（青文字）が必要のようでした。
AccessVBA 処理結果に応じてテーブルのフィールド名を変更する
例えば、日付、Field1、Field2と3つのフィールドがあるテーブルがあるとします。
計算結果によっては、Field1が商品A、ある時には商品Bなど、状況によって、Field1と2に表示したいフィールド名が可変になる場合があります。
計算元のテーブルやクエリをクロス集計クエリにしておけば出来るのですが、テーブルに一旦抽出した方が後の処理が容易くなると思います。
今回はクロス集計クエリをテーブル化するようなイメージでしょうか。
以下、VBAの記述
'----------------------------------------------------------------------------------------------
Private Sub changeFldName()
Dim db As Database
Dim tdf As TableDef
Dim rst As Recordset
Dim strSQL As String
Set db = CurrentDb
Set tdf = db.TableDefs("テーブル名") 'フィールド名を変更したいテーブル
strSQL = "SELECT テーブル元.Field1 FROM テーブル元 GROUP BY テーブル元.Field1;" 'フィールド名の参照元のテーブル
’Field1のフィールド名だけ取得するコードのみ例示
Set rst = db.OpenRecordset(strSQL,dbOpenSnapShot)
'テーブル元のField1をテーブル名のField1へ代入
'テーブル名のField1の左から2番目と想定
tdf.Fields(1).Name = rst!Field1
db.Close
Set db = Nothing
End Sub
'----------------------------------------------------------------------------------------------------
以上、VBA記述終わり。
AccessVBA フィールド名を探索して処理を分岐する
テーブルに特定のフィールド名があるかどうかを確認して、ある場合に処理をするというコードを書いてみました。
他のアクセスファイルやEXCELファイルなどから、インポート操作を行った場合に
状況によって特定のフィールド名があったりなかったりする場合には使えるのではないかと思っています。
サンプルでは、テーブル名というテーブルにフィールド名というフィールドが存在するかどうか確認して、その有無によって処理を分岐させるようなイメージです。
以下、VBA記述
'-----------------------------------------------------------------------------------------------
Private Sub test
Dim flg As Boolean 'フィールド有無の判定フラグ
’フィールドの有無を判定するプロシージャを読んで、有無の判定を読み込む
Call chekFldName(flg)
'以下 メインの処理--------------------------------------------
End Sub
’フィール名を走査するプロシージャ
Private sub chekFldName(flg As Boolean)
Dim db As Database
Dim tbl As TableDef
Dim fld As Field
Set db = CurrentDb
'フィールド名を探索するテーブル
Set tbl = db.TableDefs("テーブル名")
If tbl.RecordCount <> 0 Then
'テーブル名の全てのフィールド名を走査する
For Each fld In tbl.Fields
If fld.Name = "フィールド名" Then
flg = True
Exit For
Else
flg = False
End If
Next
db.Close
Set db = Nothing
Else
End If
End Sub
'----------------------------------------------------------------------------------------
以上、VBA記述終わり。
