投稿日 | : 2006/06/03(Sat) 23:04 |
投稿者 | : べた |
Eメール | : |
URL | : |
タイトル | : VBからExcelへの表示で、ゼロから始まる文字列の扱い |
VBからoo4o接続でデータベースからデータを抽出しています。
抽出したデータをExcelに送り表示しようとしています。
ここで、データの一部にゼロから始まる値があり、そのまま、
Execlで表示するとゼロか取り除かれた表示されます。
ゼロを取り除かれずに表示したいのですが、どうすれば良い
のでしょうか。
抽出したデータが、「000001」とすると、Excelで表示すると「1」
抽出したデータが、「099999」とすると、Excelで表示すると「99999」
となる。
これを、「000001」、「099999」としたいのです。
書式を文字列にしてみたのですが、変わりませんでした。
xlSheet.Cells.NumberFormat = "@"
以下にコードを載せます。
Private Sub Command1_Click()
Dim objSess As Object
Dim objDb As Object
Dim objDs As Object
Dim objCol As Object
Dim str_SQL As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim I As Integer
Dim j As Integer
Dim RowCnt As Integer
On Error Resume Next
Set objSess = 〜
Set objDb = 〜
str_SQL = ""
str_SQL = "SELECT 〜
Set objDs = objDb.DbCreateDynaset(str_SQL, 12&)
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Cells(1, 1) = "番号"
xlSheet.Cells(1, 2) = "名前"
xlSheet.Cells(1, 3) = "年月日"
I = 2
Do Until objDs.EOF
For j = 1 To 3
xlSheet.Cells(I, j) = objDs(j - 1).Value
Next j
I = I + 1
If I > 11 Then
Exit Do
End If
objDs.DbMoveNext
Loop
xlApp.Visible = True
RowCnt = I - 1
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(RowCnt, 3)).Borders.LineStyle =
xlContinuous '実線
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(RowCnt, 3)).Borders
(xlEdgeTop).LineStyle = xlGray75
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(RowCnt, 3)).Borders
(xlEdgeLeft).LineStyle = xlGray75
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(RowCnt, 3)).Borders
(xlEdgeRight).LineStyle = xlGray75
xlSheet.Range(xlSheet.Cells(RowCnt, 1), xlSheet.Cells(RowCnt, 3)).Borders
(xlEdgeBottom).LineStyle = xlGray75
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 3)).Borders(xlEdgeBottom).LineStyle
= xlDouble
xlSheet.Cells.NumberFormat = "@"
xlSheet.Cells.VerticalAlignment = xlVAlignCenter
xlSheet.Range("A:A").HorizontalAlignment = xlLeft
xlSheet.Range("B:B").HorizontalAlignment = xlVAlignCenter
xlSheet.Range("C:C").HorizontalAlignment = xlRight
xlSheet.Cells.Interior.Color = RGB(0, 255, 0)
On Error GoTo 0
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Set objDs = Nothing
Set objDb = Nothing
Set objSess = Nothing
Set objCol = Nothing
End Sub