ラベル VBA の投稿を表示しています。 すべての投稿を表示
ラベル VBA の投稿を表示しています。 すべての投稿を表示

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

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