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
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
登録:
投稿 (Atom)