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日木曜日

HTAにおけるカレントパスの取得

location.pathname 
実行結果
→ "D:\FolderName\SubfolderName\ FileName.hta

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

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

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

2011年10月11日火曜日

Access 2010で2003までの起動時の設定ダイアログと同様の設定を行う

▼操作手順:

[ファイル]タブ
 −[オプション]をクリック
 ↓
[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
----------------------------------------------------------
フィールド属性定数JETSQL
対応なし型
 adBinary=128
BINARYVARBINARY
Yes/No型
adBoolean=11
BOOLEANBIT
LOGICAL
LOGICAL1
YESNO
バイト型 
adUnsignedTinyInt=17
BYTEINTEGER1
オートナンバー型 
adInteger=3
COUNTERAUTOINCREMENT
通貨型
adCurrency=6
CURRENCYMONEY
日付型
adDate=7
DATETIMEDATE
TIME
TIMESTAMP
十進型
adNumeric=131
DECIMALDECIMAL
倍精度型
adDouble=5
DOUBLEFLOAT
FLOAT8
IEEEDOUBLE
NUMBER
NUMERIC
長整数型
adInteger=3
LONGINT
INTEGER
INTEGER4
OLEオブジェクト型
adLongVarBinary=205
LONGBINARYGENERAL
OLEOBJECT
メモ型
adLongVarWChar=203
LONGTEXTLONGCHAR
MEMO
NOTE
単精度型
adSingle=4
SINGLEFLOAT4
IEEESINGLE
REAL
整数型
adSmallInt=2
SHORTINTEGER2
SMALLINT
テキスト型
adVarWChar=202
TEXTALPHANUMERIC
CHAR
CHARACTER
STRING
VARCHAR
ハイパーリンク型
adLongVarWChar=203
LONGTEXTLONGCHAR
MEMO
NOTE