Cooly回答问题专用帖

[Cooly]

借这个帖子来回答一些朋友的问题.

[Cooly]

'xb_form

Private Sub Command2_Click()
DataGrid1.Visible = False
aaa.Visible = True
aaa.Clear
SQL = "select * from xs_xb order by dm"
rsopen (SQL)
aaa.Cols = 3
aaa.Rows = rs.RecordCount
cc = aaa.Width / 3 - 100
aaa.ColWidth(0) = cc
aaa.ColWidth(1) = cc
aaa.ColWidth(2) = cc
Set rs1 = New ADODB.Recordset

aaa.TextMatrix(0, 0) = "学院名称"
aaa.TextMatrix(0, 1) = "系别名称"
aaa.TextMatrix(0, 2) = "系别代码"
If rs.RecordCount > 0 Then
i = 0
Do Until rs.EOF
SQL1 = "select *from xs_xy where dm='" & Left(rs("dm"), 2) & "'"
rs1.Open SQL1, conn, 3, 3
If Not rs1.EOF Then zz = rs1("mc")
rs1.Close
aaa.TextMatrix(i, 0) = zz
aaa.TextMatrix(i, 1) = rs("mc")
aaa.TextMatrix(i, 2) = rs("dm")
rs.MoveNext
i = i + 1
Loop

End If
aaa.MergeCells = 2
aaa.MergeCol(0) = True
aaa.Refresh
End Sub

[Cooly]

声明一点,这个帖子中我只是解决一些通过MSN来问的问题,所有代码均为其他朋友提供.我只是做了一些修改.

[Cooly]

'xb_form

Private Sub Command2_Click()
DataGrid1.Visible = False
aaa.Visible = True
aaa.Clear
SQL = "select * from xs_xb order by dm"
rsopen (SQL)
aaa.Cols = 3
aaa.Rows = rs.RecordCount + 1
cc = aaa.Width / 3 - 100
aaa.ColWidth(0) = cc
aaa.ColWidth(1) = cc
aaa.ColWidth(2) = cc
Set rs1 = New ADODB.Recordset

aaa.TextMatrix(0, 0) = "学院名称"
aaa.TextMatrix(0, 1) = "系别名称"
aaa.TextMatrix(0, 2) = "系别代码"
If rs.RecordCount > 0 Then
i = 1
Do Until rs.EOF
SQL1 = "select *from xs_xy where dm='" & Left(rs("dm"), 2) & "'"
rs1.Open SQL1, conn, 3, 3
If Not rs1.EOF Then zz = rs1("mc")
rs1.Close
aaa.TextMatrix(i, 0) = zz
aaa.TextMatrix(i, 1) = rs("mc")
aaa.TextMatrix(i, 2) = rs("dm")
rs.MoveNext
i = i + 1
Loop

End If
aaa.MergeCells = 2
aaa.MergeCol(0) = True
aaa.Refresh
End Sub

[thirdapple]

Cooly的MSN是多少？

[Cooly]

Public Sub RsToTxt(RsSrc As ADODB.Recordset, CdlX As CommonDialog)
Dim MyFileName As String
Dim MyRsLine As String

CdlX.Filter = "文本文件(*.txt)|*.txt"
CdlX.ShowSave

MyFileName = CdlX.FileName

If MyFileName = "" Then
MsgBox "您没有选择文件", vbCritical
Exit Sub
End If

If Dir(MyFileName) <> "" And MyFileName <> "" Then '如果文件存在
If MsgBox("您 的确要覆盖 这个文件吗？", vbYesNo + vbQuestion) = vbYes Then
Open MyFileName For Output Access Write As #1
Else
Exit Sub
End If
Else '如果文件不存在
Open MyFileName For Append As #1
End If
'
With RsSrc
.MoveFirst
For i = 0 To .Fields.Count - 1
MyRsLine = trim(.Fields(i).Name)
MyRsLine = Space(10-Len(MyRsLine)) & MyRsLine
Print #1, MyRsLine
Next

MyRsLine = ""

End With
Close (1)
'MsgBox "导出完毕", vbInformation

End Sub

[Cooly]

TO thirdapple(陨落雕) :

MSN : [e-mail]

[Cooly]

如果想要在一行中输出:

Public Sub RsToTxt(RsSrc As ADODB.Recordset, CdlX As CommonDialog)
Dim MyFileName As String
Dim MyRsLine As String, TmpLine As String

CdlX.Filter = "文本文件(*.txt)|*.txt"
CdlX.ShowSave

MyFileName = CdlX.FileName

If MyFileName = "" Then
MsgBox "您没有选择文件", vbCritical
Exit Sub
End If

If Dir(MyFileName) <> "" And MyFileName <> "" Then '如果文件存在
If MsgBox("您 的确要覆盖 这个文件吗？", vbYesNo + vbQuestion) = vbYes Then
Open MyFileName For Output Access Write As #1
Else
Exit Sub
End If
Else '如果文件不存在
Open MyFileName For Append As #1
End If
'
With RsSrc
.MoveFirst
For i = 0 To .Fields.Count - 1
TmpLine = trim(.Fields(i).Name)
MyRsLine = MyRsLine & IIf(MyRsLine="","",Space(1)) & Space(10-Len(TmpLine)) & TmpLine
Next

Print #1, MyRsLine
MyRsLine = ""

End With
Close (1)
'MsgBox "导出完毕", vbInformation

End Sub

[victorycyz]

cooly的知道了，thirdapple(陨落雕)你的呢？可不可以帮助我？
[e-mail]

[thirdapple]

[e-mail]
数据库不懂

[Cooly]

Public Sub RsToTxt(RsSrc As ADODB.Recordset, CdlX As CommonDialog)
Dim MyFileName As String
Dim MyRsLine As String, TmpLine As String

CdlX.Filter = "文本文件(*.txt)|*.txt"
CdlX.ShowSave

MyFileName = CdlX.FileName

If MyFileName = "" Then
MsgBox "您没有选择文件", vbCritical
Exit Sub
End If

If Dir(MyFileName) <> "" And MyFileName <> "" Then '如果文件存在
If MsgBox("您 的确要覆盖 这个文件吗？", vbYesNo + vbQuestion) = vbYes Then
Open MyFileName For Output Access Write As #1
Else
Exit Sub
End If
Else '如果文件不存在
Open MyFileName For Append As #1
End If
'
With RsSrc
.MoveFirst
If .RecordCount>0 Then
Do Until .EOF
Print #1, .Fields(0) & .Fields(1) & space(15-len(.Fields(0) & .Fields(1))) & .Fields(2) & .Fields(3) & space(15-len(.Fields(2) & .Fields(3))) & format(.Fields(4),"0000000000.00")

.MoveNext
Loop
End If

End With
Close (1)
'MsgBox "导出完毕", vbInformation

End Sub

[flyingworm]

cooly能给工程文件吗？虽然你的代码风格不赖，可读源码还是有点吃力。我的邮箱在上面。我没有msn。555~~~

[Cooly]

TO flyingworm(@)21cn.com ：))) :

这个帖子我是用来回答一些朋友问题的. 上面的内容也是别人的,我只是做了修改.如果你需要什么帮助,请说明.