kanaMind
2014年12月8日月曜日
小数点以下の入力制限
Private Sub txt_Change()
FraLmt Me!txt, 2 ←テキストの内容を小数点以下2桁で制限する
End Sub
Sub FraLmt(d As TextBox, fd As Byte)
Dim x
If IsNull(d.Text) Then Exit Sub
If 0 = Len(d.Text) Then Exit Sub
If Not IsNumeric(d.Text) Then Exit Sub
x = d.Text * 10 ^ fd
If x - Fix(x) <> 0 Then
d.Text = Fix(x) / (10 ^ fd)
d.SelStart = Len(x)
End If
End Sub
2014年8月28日木曜日
2012年3月7日水曜日
Excelを操作する
'エクセルのインスタンス
Set Xl = CreateObject("Excel.Application")
Set Bk = Xl.Workbooks.Open(<xlsのフルパス>)
Set Sh = Bk.worksheets(<シート名>) 'テンプレートシート
'名前を付けて保存
Bk.worksheets("表紙").Select '複数シートが存在の場合、初期表示したいシート名-->シートオブジェクトを用意しなかったから。
Bk.SaveAs filename:=<ファイル名.xls> 'ファイル名までのパスは不要
Bk.Close
'オブジェクトの解放
Set Sh = Nothing
Set Bk = Nothing
Set Xl = Nothing
- 代入・コピペ・式---------------------------------------------------------------------
Sh.Select 'シートが複数の場合、特定のシートをアクティブにする
Sh.Range("a1").Select 'シートの指定のセルにカーソルを置く
'指定のレンジに値を代入する。
Sh.Range("B10") = RsCover!BknName '工事件名
Sh.Range("B11") = RsCover!UkeBasho '受渡場所
Sh.Range("B12") = RsCover!KokiKenshu '工期・検収日
Sh.Range("B13") = RsCover!ShihaJoken '支払条件
'連続代入
Do Until RsMeis.EOF
Sh.Range("A" & iLine) = RsMeis("TekyName1")
Sh.Range("B" & iLine) = RsMeis("TekyName2")
Sh.Range("C" & iLine) = RsMeis("Suryo")
Sh.Range("D" & iLine) = RsMeis("TaniName")
Sh.Range("E" & iLine) = RsMeis("Tanka")
Sh.Range("F" & iLine) = RsMeis("Kingaku")
Sh.Range("G" & iLine) = RsMeis("Bikou")
iLine = iLine + 1
RsMeis.MoveNext
Loop
'計算式の設定
Shiki = "=Sum(F" & iLine & ":F" & iLine - 1 + vBody & ")"
Sh.range("F" & ShikiLine).formula = Shiki
Sh.range("A" & UchiLine).formula = "='シート名'!レンジ名 '他シートのセルを参照させる
'--- 横幅の設定(コピー&ペースト)-----
ShT.Select
ShT.Columns("A:G").Select
Xl.Selection.Copy
Sh.Select
Sh.Columns("A:A").Select
Sh.Paste
'行情報文字のクリア
ShT.Columns(sCol & ":" & sCol).Select
Xl.Selection.ClearContents
Set Xl = CreateObject("Excel.Application")
Set Bk = Xl.Workbooks.Open(<xlsのフルパス>)
Set Sh = Bk.worksheets(<シート名>) 'テンプレートシート
'名前を付けて保存
Bk.worksheets("表紙").Select '複数シートが存在の場合、初期表示したいシート名-->シートオブジェクトを用意しなかったから。
Bk.SaveAs filename:=<ファイル名.xls> 'ファイル名までのパスは不要
Bk.Close
'オブジェクトの解放
Set Sh = Nothing
Set Bk = Nothing
Set Xl = Nothing
- 代入・コピペ・式---------------------------------------------------------------------
Sh.Select 'シートが複数の場合、特定のシートをアクティブにする
Sh.Range("a1").Select 'シートの指定のセルにカーソルを置く
'指定のレンジに値を代入する。
Sh.Range("B10") = RsCover!BknName '工事件名
Sh.Range("B11") = RsCover!UkeBasho '受渡場所
Sh.Range("B12") = RsCover!KokiKenshu '工期・検収日
Sh.Range("B13") = RsCover!ShihaJoken '支払条件
'連続代入
Do Until RsMeis.EOF
Sh.Range("A" & iLine) = RsMeis("TekyName1")
Sh.Range("B" & iLine) = RsMeis("TekyName2")
Sh.Range("C" & iLine) = RsMeis("Suryo")
Sh.Range("D" & iLine) = RsMeis("TaniName")
Sh.Range("E" & iLine) = RsMeis("Tanka")
Sh.Range("F" & iLine) = RsMeis("Kingaku")
Sh.Range("G" & iLine) = RsMeis("Bikou")
iLine = iLine + 1
RsMeis.MoveNext
Loop
'計算式の設定
Shiki = "=Sum(F" & iLine & ":F" & iLine - 1 + vBody & ")"
Sh.range("F" & ShikiLine).formula = Shiki
Sh.range("A" & UchiLine).formula = "='シート名'!レンジ名 '他シートのセルを参照させる
'--- 横幅の設定(コピー&ペースト)-----
ShT.Select
ShT.Columns("A:G").Select
Xl.Selection.Copy
Sh.Select
Sh.Columns("A:A").Select
Sh.Paste
'行情報文字のクリア
ShT.Columns(sCol & ":" & sCol).Select
Xl.Selection.ClearContents
2012年2月15日水曜日
VBAでの正規表現
Dim RegEx As Object
Dim Matches As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.IgnoreCase = True
RegEx.Global = True
'--- マッチしたかどうかテストする ----
RegEx.Pattern = "正規表現マッチパターン"
If RegEx.Test(文字列) Then
MsgBox "マッチしました"
Else
MsgBox "マッチしませんでした"
End If
'--- マッチしたときのn番目のグループ値を取出す ---
' $1 --- SubMatches(0)
' $2 --- SubMatches(1)
' $3 --- SubMatches(2)
RegEx.Pattern = "(\d{4})/(\d{2})/(\d{2})" '日付の形式
Set Matches = RegEx.Execute("2012/02/14")
If 0 < Matches.Count Then
MsgBox Matches(0).SubMatches(0) '2012
MsgBox Matches(0).SubMatches(1) '02
MsgBox Matches(0).SubMatches(3) '14
End If
Dim Matches As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.IgnoreCase = True
RegEx.Global = True
'--- マッチしたかどうかテストする ----
RegEx.Pattern = "正規表現マッチパターン"
If RegEx.Test(文字列) Then
MsgBox "マッチしました"
Else
MsgBox "マッチしませんでした"
End If
'--- マッチしたときのn番目のグループ値を取出す ---
' $1 --- SubMatches(0)
' $2 --- SubMatches(1)
' $3 --- SubMatches(2)
RegEx.Pattern = "(\d{4})/(\d{2})/(\d{2})" '日付の形式
Set Matches = RegEx.Execute("2012/02/14")
If 0 < Matches.Count Then
MsgBox Matches(0).SubMatches(0) '2012
MsgBox Matches(0).SubMatches(1) '02
MsgBox Matches(0).SubMatches(3) '14
End If
2012年2月2日木曜日
Access Printer Object 変更して印刷
Sub RestoreReportPrinter()
Dim rpt As Report
Dim prtOld As Printer
Dim prtNew As Printer
DoCmd.OpenReport ReportName:="商品区分別商品リスト", View:=acViewPreview
Set rpt = Reports("商品区分別商品リスト")
'レポートの現在のプリンタ設定を prtOld 変数に保存します。
Set prtOld = rpt.Printer
'レポートの現在のプリンタ設定を prtNew 変数に代入します。
Set prtNew = rpt.Printer
'レポートの設定を変更
With prtNew
'用紙の向きを横に設定
.Orientation = acPRORLandscape
'印刷するページの上の余白を 30mm に設定
.TopMargin = Round(30 * 56.7, 2)
'印刷部数を 2 部に設定
.Copies = 2
'上下にページをめくる両面印刷の印刷の向きに設定
.Duplex = acPRDPVertical
'給紙トレイを上段に設定
.PaperBin = acPRBNUpper
End With
'印刷します。
Docmd.RunCommand acCmdPrint
'プリンタを元の設定に戻します。
Set rpt.Printer = prtOld
'保存せずに、レポートを閉じます。
DoCmd.Close ObjectType:=acReport, ObjectName:="商品区分別商品リスト", Save:=acSaveNo
Set rpt = Nothing
Set prtNew = Nothing
Set prtOld = Nothing
End Sub
Dim rpt As Report
Dim prtOld As Printer
Dim prtNew As Printer
DoCmd.OpenReport ReportName:="商品区分別商品リスト", View:=acViewPreview
Set rpt = Reports("商品区分別商品リスト")
'レポートの現在のプリンタ設定を prtOld 変数に保存します。
Set prtOld = rpt.Printer
'レポートの現在のプリンタ設定を prtNew 変数に代入します。
Set prtNew = rpt.Printer
'レポートの設定を変更
With prtNew
'用紙の向きを横に設定
.Orientation = acPRORLandscape
'印刷するページの上の余白を 30mm に設定
.TopMargin = Round(30 * 56.7, 2)
'印刷部数を 2 部に設定
.Copies = 2
'上下にページをめくる両面印刷の印刷の向きに設定
.Duplex = acPRDPVertical
'給紙トレイを上段に設定
.PaperBin = acPRBNUpper
End With
'印刷します。
Docmd.RunCommand acCmdPrint
'プリンタを元の設定に戻します。
Set rpt.Printer = prtOld
'保存せずに、レポートを閉じます。
DoCmd.Close ObjectType:=acReport, ObjectName:="商品区分別商品リスト", Save:=acSaveNo
Set rpt = Nothing
Set prtNew = Nothing
Set prtOld = Nothing
End Sub
2011年10月11日火曜日
Access 2010で2003までの起動時の設定ダイアログと同様の設定を行う
▼操作手順:
[ファイル]タブ
−[オプション]をクリック
↓
[Accessのオプション]ダイアログ
−[カレントデータベース]をクリック
↓
設定変更後
[Accessのオプション]ダイアログ
−[OK]ボタンをクリック
[ファイル]タブ
−[オプション]をクリック
↓
[Accessのオプション]ダイアログ
−[カレントデータベース]をクリック
↓
設定変更後
[Accessのオプション]ダイアログ
−[OK]ボタンをクリック
2011年10月5日水曜日
Memory上でRecordsetを使用する
Option Explicit
'
' inmemrs.wsf - インメモリでrecordsetを作成してオープンする
'
Dim objRec, varFields
Set objRec = CreateObject("ADODB.Recordset")
varFields = Array("BookID", "Title", "Price")
With objRec
With .Fields
.Append varFields(0), adInteger
.Append varFields(1), adChar, 100
.Append varFields(2), adCurrency
End With
.Open
.AddNew varFields, Array(100, "HogeHoge", 1200)
.AddNew varFields, Array(101, "FugaFuga", 1400)
.AddNew varFields, Array(102, "FooVar", 900)
.Update
End With
objRec.Save "sample.xml", adPersistXML
Set objRec = Nothing
----------------------------------------------------------
Rs.Sort = "FieldName ASC,FieldName2 DESC"
Rs.MoveFirst
Do Until Rs.Eof
xxxxxxx
Rs.MoveNext
Loop
Rs.Close
----------------------------------------------------------
'
' inmemrs.wsf - インメモリでrecordsetを作成してオープンする
'
Dim objRec, varFields
Set objRec = CreateObject("ADODB.Recordset")
varFields = Array("BookID", "Title", "Price")
With objRec
With .Fields
.Append varFields(0), adInteger
.Append varFields(1), adChar, 100
.Append varFields(2), adCurrency
End With
.Open
.AddNew varFields, Array(100, "HogeHoge", 1200)
.AddNew varFields, Array(101, "FugaFuga", 1400)
.AddNew varFields, Array(102, "FooVar", 900)
.Update
End With
objRec.Save "sample.xml", adPersistXML
Set objRec = Nothing
----------------------------------------------------------
Rs.Sort = "FieldName ASC,FieldName2 DESC"
Rs.MoveFirst
Do Until Rs.Eof
xxxxxxx
Rs.MoveNext
Loop
Rs.Close
----------------------------------------------------------
フィールド属性定数 | JET | SQL |
---|---|---|
対応なし型 adBinary=128 | BINARY | VARBINARY |
Yes/No型 adBoolean=11 | BOOLEAN | BIT LOGICAL LOGICAL1 YESNO |
バイト型 adUnsignedTinyInt=17 | BYTE | INTEGER1 |
オートナンバー型 adInteger=3 | COUNTER | AUTOINCREMENT |
通貨型 adCurrency=6 | CURRENCY | MONEY |
日付型 adDate=7 | DATETIME | DATE TIME TIMESTAMP |
十進型 adNumeric=131 | DECIMAL | DECIMAL |
倍精度型 adDouble=5 | DOUBLE | FLOAT FLOAT8 IEEEDOUBLE NUMBER NUMERIC |
長整数型 adInteger=3 | LONG | INT INTEGER INTEGER4 |
OLEオブジェクト型 adLongVarBinary=205 | LONGBINARY | GENERAL OLEOBJECT |
メモ型 adLongVarWChar=203 | LONGTEXT | LONGCHAR MEMO NOTE |
単精度型 adSingle=4 | SINGLE | FLOAT4 IEEESINGLE REAL |
整数型 adSmallInt=2 | SHORT | INTEGER2 SMALLINT |
テキスト型 adVarWChar=202 | TEXT | ALPHANUMERIC CHAR CHARACTER STRING VARCHAR |
ハイパーリンク型 adLongVarWChar=203 | LONGTEXT | LONGCHAR MEMO NOTE |
登録:
投稿 (Atom)