四捨五入

'------------------------------------------------------------------------
'概 要：四捨五入
'引 数：dblValue 四捨五入対象
' intiti 四捨五入する位置
' -2 ⇒ ２桁目で四捨五入
' -1 ⇒ １桁目で四捨五入
' 0 ⇒ 少数第一位で四捨五入
' 1 ⇒ 少数第二位で四捨五入
' 2 ⇒ 少数第三位で四捨五入
'戻り値：四捨五入された数値
'------------------------------------------------------------------------
Public Function Round(ByVal dblValue As Double, ByVal intIti As Integer) As Double

Dim dblShift As Double

dblShift = System.Math.Pow(10, intIti)

If dblValue > 0 Then
Return System.Math.Floor ((dblValue * dblShift) + 0.5) / dblShift
Else
Return System.Math.Ceiling((dblValue * dblShift) - 0.5) / dblShift
End If

End Function
ラベル:

Format関数（数値）

※VB6の時と違って、一旦cInt関数で数値型に変換する必要がある

cInt("123456").ToString("#,##0") '３桁カンマ

cInt("123456").ToString("00000") 'ゼロ詰め
ラベル: ,

Format関数（日付）

※VB6の時と違って、一旦cDate関数で日付型に変換する必要がある

Dim dtYMD As DateTime
dtYMD = cDate("2003/4/3")

MsgBox(dtYMD.ToString("yyyy/MM/dd (ddd) HH:mm:ss"))


※月はVB6のときはmmだったが、MMと大文字にしないと分になってしまうなど大文字と小文字に注意が必要。
ラベル: ,

IsDate関数

'===============================================================
'機 能：日付のチェックを行う。(年月日) YYYY,MM,DD
'引 数：int_SW I integer チェックパタン
' 1･･年月日のチェック
' 2･･年月 のチェック
' 3･･年 のチェック
' str_YYYY I String チェック年
' str_MM I String チェック月
' str_DD I String チェック日
'戻り値：True = ＯＫ
' ：False = ＮＧ
'===============================================================
Public Function Chk_Date(ByVal int_SW As Integer, ByVal str_YYYY As String, ByVal str_MM As String, ByVal str_DD As String) As Boolean

Try

Select Case int_SW
Case 1
Dim DateCheck As New Date(str_YYYY, str_MM, str_DD)
Case 2
Dim DateCheck As New Date(str_YYYY, str_MM, "01")
Case 3
Dim DateCheck As New Date(str_YYYY, "01", "01")
End Select

Return True

Catch ex As Exception
Return False

End Try

End Function
ラベル: ,

符号を返す

Dim intSign As Integer

intSign As Integer = System.Math.Sign(-5)

正 ⇒ 1
ゼロ ⇒ 0
負 ⇒ -1
ラベル: ,

絶対値

Dim intAbs As Integer

intAbs = System.Math.Abs(-60)
ラベル: ,

コマンドライン引数取得

Dim strArgs() As String '配列

strArgs = System.Environment.GetCommandLineArgs


■System.Environment.GetCommandLineArgs(0)には実行可能ファイルの名前がセットされている。
要素の1以降にコマンドライン引数が設定される。
ラベル:

コンピュータ名取得

strCompNm = System.Windows.Forms.SystemInformation.ComputerName
ラベル:

INSERT,UPDATE,DELETE

Public Ado_Connect_String As String ' 接続文字列

Public Ado_Connect As New ADODB.Connection
Public Ado_DbCommand As New ADODB.Command
Public Ado_RecSet As New ADODB.Recordset

Public SetDBServer As String ' データベースサーバー名
Public SetDBNM As String ' データベース名
Public SetServerNM As String ' サーバー名
Public SetUserID As String ' ユーザID
Public SetPass As String ' パスワード

Public DbAccess_ExecSQL AS Object

'データベースコネクト文字列作成
Ado_Connect_String = "Provider=SQLOLEDB.1;" + _
"Persist Security Info=False;" + _
"User ID=" + SetUserID + ";" + _
"password =" + SetPass + ";" + _
"Initial Catalog=" + SetDBNM + ";" + _
"Data Source=" + SetDBServer + ";" + _
"Use Procedure for Prepare=1;" + _
"Auto Translate=True;" + _
"Packet Size=4096;" + _
"Workstation ID=" + SetServerNM + ";" + _
"Use Encryption for Data=False;" + _
"Tag with column collation when possible=False"

'データベースコネクト処理
Ado_Connect.Open(Ado_Connect_String)

'データベースのトランザクション開始処理
Ado_Connect.BeginTrans()


Ado_RecSet = New ADODB.Recordset
'ﾃｰﾌﾞﾙのﾚｺｰﾄﾞｾｯﾄをｵｰﾌﾟﾝする。
Ado_RecSet.Open(Sql_String, Ado_Connect, ADODB.CursorTypeEnum.adOpenKeyset, ADODB.LockTypeEnum.adLockReadOnly)



'取得したﾚｺｰﾄﾞ数(戻り値)
DbAccess_ExecSQL = Ado_Connect.Execute(Sql_String)



'データベースのコミット処理
Ado_Connect.CommitTrans()


'データベースのコミット処理
Ado_Connect.RollbackTrans()


'データベースのクローズ処理
Ado_Connect.Close()
Ado_Connect = Nothing
ラベル: , , , , , ,

DB OPENからSELECT文発行まで

先に『adodb』を参照設定しておく。


Public Ado_Connect_String As String ' 接続文字列

Public Ado_Connect As New ADODB.Connection
Public Ado_DbCommand As New ADODB.Command
Public Ado_RecSet As New ADODB.Recordset

Public SetDBServer As String ' データベースサーバー名
Public SetDBNM As String ' データベース名
Public SetServerNM As String ' サーバー名
Public SetUserID As String ' ユーザID
Public SetPass As String ' パスワード


'データベースコネクト文字列作成
Ado_Connect_String = "Provider=SQLOLEDB.1;" + _
"Persist Security Info=False;" + _
"User ID=" + SetUserID + ";" + _
"password =" + SetPass + ";" + _
"Initial Catalog=" + SetDBNM + ";" + _
"Data Source=" + SetDBServer + ";" + _
"Use Procedure for Prepare=1;" + _
"Auto Translate=True;" + _
"Packet Size=4096;" + _
"Workstation ID=" + SetServerNM + ";" + _
"Use Encryption for Data=False;" + _
"Tag with column collation when possible=False"

'データベースコネクト処理
Ado_Connect.Open(Ado_Connect_String)

'データベースのトランザクション開始処理
Ado_Connect.BeginTrans()


Ado_RecSet = New ADODB.Recordset
'ﾃｰﾌﾞﾙのﾚｺｰﾄﾞｾｯﾄをｵｰﾌﾟﾝする。
Ado_RecSet.Open(Sql_String, Ado_Connect, ADODB.CursorTypeEnum.adOpenKeyset, ADODB.LockTypeEnum.adLockReadOnly)



'取得したﾚｺｰﾄﾞ数(戻り値)
If Ado_RecSet.RecordCount = 0 Then




End IF



'データベースのコミット処理
Ado_Connect.CommitTrans()


'データベースのコミット処理
Ado_Connect.RollbackTrans()


'データベースのクローズ処理
Ado_Connect.Close()
Ado_Connect = Nothing
ラベル: , , , , ,

色の設定と比較

Private prColor As System.Drawing.Color = System.Drawing.Color.LightCoral

'色の設定
TextBox.BackColor = prColor.ToArgb

If TextBox.BackColor.ToArgb = prColor.ToArgb Then
'色の比較
End If
ラベル: ,

ファイル存在チェック

'===============================================================
'機能 ：ファイルの存在チェック
'引数 ：strPath IN 存在チェックを行うパス＋ファイル名
'戻り値：True 正常
'　　　：False　異常
'===============================================================
Private Function FindFile(ByVal strPath As String) As Boolean

Try

' ファイル存在チェック
If System.IO.File.Exists(strPath) = False Then
MessageBox.Show("ファイルが存在しません。" & vbCrLf & "(" & strPath & ")")
Return False
End If

Return True

Catch ex As Exception
MessageBox.Show(ex.ToString, Me.Text)
Return False
End Try

End Function
ラベル: ,

Framework 対応

■Visual Basic.NET (2002)
.NET Framework 1.0


■Visual Basic.NET 2003
.NET Framework 1.1


■Visual Basic 2005
.NET Framework 2.0, 3.0


■Visual Basic 2008
.NET Framework 3.5, 3.0, 2.0
ラベル:

アクティブセルの移動

'左上にエラー発生行がくるようにする
spr.Sheets(0).SetActiveCell(iRow2, 0)
spr.ShowActiveCell(FarPoint.Win.Spread.VerticalPosition.Center, FarPoint.Win.Spread.HorizontalPosition.Center)


'アクティブセルの移動
spr.Sheets(0).ActiveColumnIndex = 1
spr.Sheets(0).ActiveRowIndex = 1


spr.Focus()
ラベル: ,

スプレッドにてENTER時にセルを右移動させる

'ENTER時にセルを右移動させる
Dim im As New FarPoint.Win.Spread.InputMap

' 非編集セルでの[Enter]キーを「次列へ移動」とします
im = sprSearchData.GetInputMap(FarPoint.Win.Spread.InputMapMode.WhenFocused)
im.Put(New FarPoint.Win.Spread.Keystroke(Keys.Enter, Keys.None), FarPoint.Win.Spread.SpreadActions.MoveToNextColumnWrap)
im.Put(New FarPoint.Win.Spread.Keystroke(Keys.Enter, Keys.Shift), FarPoint.Win.Spread.SpreadActions.MoveToPreviousColumnWrap)

' 編集中セルでの[Enter]キーを「次列へ移動」とします
im = sprSearchData.GetInputMap(FarPoint.Win.Spread.InputMapMode.WhenAncestorOfFocused)
im.Put(New FarPoint.Win.Spread.Keystroke(Keys.Enter, Keys.None), FarPoint.Win.Spread.SpreadActions.MoveToNextColumnWrap)
im.Put(New FarPoint.Win.Spread.Keystroke(Keys.Enter, Keys.Shift), FarPoint.Win.Spread.SpreadActions.MoveToPreviousColumnWrap)
ラベル: ,

Excelを開いて、セルの値を取得する

Dim ExcelApp As Object = Nothing 'Excel.Application
Dim Books As Object = Nothing 'Excel.Workbooks
Dim Book As Object = Nothing 'Excel.Workbook
Dim Sheets As Object = Nothing 'Excel.Worksheets
Dim rng As Object 'Range オブジェクト


ExcelApp = CreateObject("Excel.Application")
Books = ExcelApp.Workbooks

' 既存の Excel ブックを開く
Book = Books.Open(prtypXlsFileInfo(intFileNo).strFullPath)
Sheets = Book.Worksheets


rng = DirectCast(Sheets.Cells(iRow, iCol), Excel.Range)
Messagebox.Show(rng.Text.ToString()) 'セルの内容


'毎回表示されるメッセージ『変更を保存しますか？』を出さないようにする。
ExcelApp.DisplayAlerts = False

Book.Close()
Books.Close()
ExcelApp.Quit()

' COM オブジェクトの参照カウントを解放する
System.Runtime.InteropServices.Marshal.ReleaseComObject(Sheets)
System.Runtime.InteropServices.Marshal.ReleaseComObject(Book)
System.Runtime.InteropServices.Marshal.ReleaseComObject(Books)
System.Runtime.InteropServices.Marshal.ReleaseComObject(ExcelApp)
ラベル: ,

２重起動禁止

↓パブリック変数で宣言
'２重起動禁止用
Dim hMutex As New System.Threading.Mutex(False, Application.ProductName)


↓フォームロード時
'２重起動防止
If hMutex.WaitOne(0, False) = True Then
GC.KeepAlive(hMutex)
Else
MessageBox.Show("２重起動できません", Me.Text)
Me.Close()
Exit Sub
End If

↓フォームクローズ時
hMutex.Close()
ラベル:

砂時計

'砂時計
Me.Cursor.Current = Cursors.WaitCursor

'砂時計を元に戻す
Me.Cursor.Current = Cursors.Default
ラベル:

文字列のバイト数を返す

'===============================================================
'機能 ：文字列のバイト数を返す
'引数 ：objValue チェック対象文字
'戻り値：バイト数
'===============================================================
Public Function vbLeftB(ByVal strValue As String) As Integer

Dim SJIS As System.Text.Encoding = System.Text.Encoding.GetEncoding("shift-jis")

Dim strByteChar() As Byte

strByteChar = SJIS.GetBytes(strValue)

vbLeftB = strByteChar.Length()

End Function
ラベル:

文字列を指定したバイト数で切る

'===============================================================
'機能 ：第１引数で指定した文字列を第２引数で指定したバイト数で切り取った文字を返す。
'引数 ：objValue チェック対象文字
'　　　：strRep 切り取るバイト数
'戻り値：切り取った文字列
'===============================================================
Public Function CutByte(ByVal strMoji As String, ByVal intByte As Integer) As String
Dim Length As Integer '文字列もレングス

'空文字に対しては常に空文字を返す
If strMoji = "" Then
Return ""
End If

'Lengthが0か、Start以降のバイト数をオーバーする場合はStart以降の全バイトが指定されたものとみなす。
Dim RestLength As Integer = System.Text.Encoding.GetEncoding("Shift_JIS").GetByteCount(strMoji)
If intByte = 0 OrElse intByte > RestLength Then
intByte = RestLength
End If

'切り抜き

Dim SJIS As System.Text.Encoding = System.Text.Encoding.GetEncoding("Shift-JIS")
Dim Byt() As Byte = CType(Array.CreateInstance(GetType(Byte), intByte), Byte())

Array.Copy(SJIS.GetBytes(strMoji), 0, Byt, 0, intByte)

Dim st1 As String = SJIS.GetString(Byt)

'▼切り抜いた結果、最後の１バイトが全角文字の半分だった場合、その半分は切り捨てる。

Dim ResultLength As Integer = System.Text.Encoding.GetEncoding("Shift_JIS").GetByteCount(st1)

If Asc(Strings.Right(st1, 1)) = 0 Then
'VB.NET2002,2003の場合、最後の１バイトが全角の半分の時
Return st1.Substring(0, st1.Length - 1)
ElseIf Length = ResultLength - 1 Then
'VB2005の場合で最後の１バイトが全角の半分の時
Return st1.Substring(0, st1.Length - 1)
Else
'その他の場合
Return st1
End If
End Function
ラベル:
登録: 投稿 (Atom)