VisualBasic

2008年5月17日 (土)

Format関数 小数点以下使用時の注意

小数点以下の値がある数値をFoamatする場合、小数点以下の桁数が合っていないと上手くいかない。
(VB6.0)
 
桁数が多いと整数部で四捨五入されるようだ。
format(11123332.999999976,"#,##0.00")
→ 11,123,333.00
format(11123332.999999976,"#,##0.##")
→ 11,123,333.
 
桁数が合っていたら上手く行く
format(11123332.99,"#,##0.00")
→ 11,123,332.99
format(11123332.99,"#,##0.##")
→ 11,123,332.99

2007年11月26日 (月)

[VB]プログラムを指定時間止める。

Declare Sub Sleep Lib "KERNEL32" (ByVal MSeconds As Long)
Private Sub Command1_Click()
Sleep (1000) 'ミリ秒単位で指定。
End Sub

2007年4月11日 (水)

VB6.0 CSVファイル作成

WriteではなくPrintでやらないと上手くいかない。
Writeでやると1行全体が””でくくられる。
以下実例。
--------------------------------------------
Private Sub cmdCSV_Click()
   
    Dim strFileName  As String '出力先ファイル名
    Dim lngRow As Long      '配列用
    Dim lngRowI As Long     '入庫用
    Dim lngRowO As Long     '出庫用
    Dim lngLast As Long     '配列の数
    On Error GoTo ErrorHandler
   
    'ダイアログ表示
    dlgFile.FileName = "在庫履歴検索結果_" & Format(Now(), "YYYYMMDD_hhmmss")
    strFileName = f_OpenCommonDialog(dlgFile, enumFileFilter.cCSVFile, "在庫履歴検索")
     
    If strFileName = "" Then
        MsgBox MSG_4544, MSG_WAR, Me.Caption
        Exit Sub
    End If
   
    Screen.MousePointer = vbHourglass
   
    '--出力用配列作成
    '標題
    ReDim mCsvData(0)
    With mCsvData(0)
        .SR_DATE_F = "【検索】年月(FROM)"
        .SR_DATE_T = "【検索】年月(TO)"
        .SR_BASE_NAME = "【検索】拠点"
        .SR_STORAGE_AREA = "【検索】保管場所"
        .SR_LOT_NO = "【検索】ロット番号"
        .ITEM_NUM = "品番"
        .ITEM_NM = "品名"
        .IN_DATE = "入庫日"
        .IN_LOT_NO = "ロット番号(入庫)"
        .IN_VOL = "入庫数"
        .IN_DEPT_CD = "入庫部門(コード)"
        .IN_DEPT_NM = "入庫部門(名)"
        .OUT_DATE = "出庫日"
        .OUT_LOT_NO = "ロット番号(出庫)"
        .OUT_VOL = "出庫数"
        .OUT_DEPT_CD = "出庫部門(コード)"
        .OUT_DEPT_NM = "出庫部門(名)"
    End With
   
    lngRow = 1
    lngRowI = 1
    lngRowO = 1
    Do Until lngRowI = flxIn_List.Rows And lngRowO = flxOut_List.Rows
        ReDim Preserve mCsvData(lngRow)
       
        '検索項目・品番項目
        With mCsvData(lngRow)
            .SR_DATE_F = imtxtDate.Text
            .SR_DATE_T = imtxtDate2.Text
            .SR_BASE_NAME = cboBase_Name.Text
            .SR_STORAGE_AREA = imtxtStorage_Area_Name.Text
            .SR_LOT_NO = imtxtLot_No.Text
            .ITEM_NUM = imtxtItemNUM.Text
            .ITEM_NM = imtxtItemNM.Text
        End With
        '入庫
        If lngRowI < flxIn_List.Rows Then
            '出庫側データがもうない場合
            If lngRowO = flxOut_List.Rows Then
                Call s_AddCsvAry("IN", lngRow, lngRowI)
            ElseIf CDate(flxIn_List.TextMatrix(lngRowI, enumGridSumCol.Grid_Date)) <= _
                            CDate(flxOut_List.TextMatrix(lngRowO, enumGridSumCol.Grid_Date)) Then
                Call s_AddCsvAry("IN", lngRow, lngRowI)
            End If
        End If
       
        '出庫
        If lngRowO < flxOut_List.Rows Then
            If mCsvData(lngRow).IN_DATE = "" Then
                Call s_AddCsvAry("OUT", lngRow, lngRowO)
            ElseIf CDate(flxOut_List.TextMatrix(lngRowO, enumGridSumCol.Grid_Date)) = CDate(mCsvData(lngRow).IN_DATE) Then
                Call s_AddCsvAry("OUT", lngRow, lngRowO)
            End If
        End If
       
       lngRow = lngRow + 1
    Loop
    lngLast = lngRow - 1
    Open strFileName For Output As #1
   
    For lngRow = 0 To lngLast
        Print #1, f_MakeCsvLine(lngRow)
    Next
   
    Close #1
   
    MsgBox MSG_4543, MSG_OK, Me.Caption
   
    Screen.MousePointer = vbDefault
    Exit Sub
   
ErrorHandler:
   
    Screen.MousePointer = vbDefault
    Call ERRMSG("cmdCSV_Click", Err)
   
End Sub
Private Function f_MakeCsvLine(p_lngRow As Long) As String
    Dim strTemp As String
   
    strTemp = ""
   
    '標題および文字として出力するものには「"」をつける
    With mCsvData(p_lngRow)
       
        strTemp = strTemp & Chr(34) & .SR_DATE_F & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .SR_DATE_T & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .SR_BASE_NAME & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .SR_STORAGE_AREA & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .SR_LOT_NO & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .ITEM_NUM & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .ITEM_NM & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .IN_DATE & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .IN_LOT_NO & Chr(34) & ","
        If p_lngRow = 0 Then
            strTemp = strTemp & Chr(34) & .IN_VOL & Chr(34) & ","
        Else
            strTemp = strTemp & .IN_VOL & ","
        End If
        strTemp = strTemp & Chr(34) & .IN_DEPT_CD & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .IN_DEPT_NM & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .OUT_DATE & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .OUT_LOT_NO & Chr(34) & ","
        If p_lngRow = 0 Then
            strTemp = strTemp & Chr(34) & .OUT_VOL & Chr(34) & ","
        Else
            strTemp = strTemp & .OUT_VOL & ","
        End If
        strTemp = strTemp & Chr(34) & .OUT_DEPT_CD & Chr(34) & ","
        strTemp = strTemp & Chr(34) & .OUT_DEPT_NM & Chr(34)
       
    End With
   
    f_MakeCsvLine = strTemp
End Function

2006年6月 1日 (木)

カーソルは宣言されませんでした

RDO使用時、このエラーが出ることがある。
rdoErrors(0).Descriptionの内容は「カーソルは宣言されませんでした」となっている。
イミィディエイトで
rdoErrors(1).Description
を見ると、エラーの内容が分かる。
場合によってはrdoErrors(i).Description
i=2以上もあるのかも。あれば見てみる。