MDB之Table输出到Word

原创 2004年02月17日 18:17:00

一个简单的MDB之Table输出到Word的vb小程序,包括简单的查询、排序和分组功能。 欢迎批评交流cwxiao888@163.com

Option Explicit
Dim DataType(100) As Integer
Dim SqlString As String
Dim OrderStr As String
Dim TalNaStr As String
Dim i As Integer
Dim MacroName As String
Private WordApp As Word.Application
Private doc As Word.Document
Private se1 As Word.Selection
Private db As Database
Private rs As Recordset


Private Sub CmdQuery_Click()
'On Error Resume Next
TalNaStr = Data1.Caption
'queryprintfrm.Data1.DatabaseName = datalistfrm.Text1.Text
'queryprintfrm.Data1.RecordSource = datalistfrm.Combo1.Text
'queryprintfrm.Data1.DatabaseName = datalistfrm.Text1.Text
queryprintfrm.Data1.RecordSource = datalistfrm.Combo1.Text


queryprintfrm.Data1.Refresh

If Me.Exp1.Text = "Like" Then
OrderStr = FindField.Text
queryprintfrm.Data1.RecordSource = "select * from" + " " + TalNaStr + " " + "where" + " " + Me.FindField.Text + " " + "like" + " " + "'" + Me.Range1.Text + "'" + " " + "order by " + " " + OrderStr
Me.Data1.Refresh
Me.DBGrid1.Refresh
Me.Refresh
End If

If Me.Exp1.Text = "In" Then
OrderStr = FindField.Text
queryprintfrm.Data1.RecordSource = "select * from" + " " + TalNaStr + " " + "where" + " " + Me.FindField.Text + " " + "In" + " " + "(" + "'" + Me.Range1.Text + "'" + ")" + " " + "order by " + " " + OrderStr
Me.Data1.Refresh
Me.DBGrid1.Refresh
Me.Refresh
End If
On Error Resume Next
Select Case Data1.Recordset.Fields(ComFind.ListIndex).Type
Case 1, 4, 5
SqlString = "select*from" + TalNaStr + " where " + FindField.Text + " " + Exp1.Text + " " + Range1.Text
Case 10
SqlString = "select*from " + TalNaStr + " where " + FindField.Text + "" + Exp1.Text + "" + "'" + Range1.Text + "'"
Case 8
SqlString = "select*from " + TalNaStr + " where " + FindField.Text + Exp1.Text + "CDate(" + "'" + Range1.Text + "')"

End Select
OrderStr = FindField.Text
QueryData SqlString, OrderStr

End Sub

 

Private Sub Combo1_Click()
On Error Resume Next
TalNaStr = Data1.Caption
Data1.RecordSource = "select" + " " + Combo1.Text + " " + "from" + " " + TalNaStr + " " + "group by " + " " + Combo1.Text
'Data1.RecordSource = "select *from  order by name"
Data1.Refresh
DBGrid1.Refresh
Data1.Recordset.MoveLast
Me.Label8.Caption = Me.Data1.Recordset.RecordCount
Me.Refresh
End Sub

Private Sub ComFind_Click()
FindField.Text = ComFind.Text
Range1.Text = ""
ComSort.Text = ComFind.Text
Me.Refresh
End Sub

Private Sub Command1_Click()
On Error Resume Next
         For i = 0 To List1.ListCount - 1 Step 1
         If List1.Selected(i) Then
            List2.AddItem List1.Text
            List1.RemoveItem (List1.ListIndex)
            Exit Sub
            End If
            Next
           
            List1.SetFocus
            List1.Text = List1.List(0)
           
            If List1.List(0) = "" Then
            List2.SetFocus
            List2.Text = List2.List(0)
            End If
End Sub

Private Sub Command10_Click()
Dim sfile As String
     With dlgCommonDialog
         .DialogTitle = "打开数据库文件"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "所有数据库文件*.mdb|*.mdb|"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sfile = .FileName
      
        Data1.Caption = .FileTitle
    End With
'        Data1.Database = Label3.Caption

        Data1.DatabaseName = sfile
'        Data1.RecordSource =
'         On Error Resume Next
                
         Data1.Refresh
'        Form1.MSFlexGrid1.Refresh
        Form1.DBGrid1.Refresh
        Form1.Refresh
End Sub

Private Sub Command2_Click()

'Set db = OpenDatabase(datalistfrm.Text1.Text)
'Set rs = db.OpenRecordset(datalistfrm.Combo1.Text)
Set db = Data1.Database
Set rs = Data1.Recordset
Data1.Refresh

Set WordApp = New Word.Application
WordApp.Documents.Add
Set doc = WordApp.ActiveDocument
Set se1 = WordApp.Selection

      With doc.PageSetup
            .LineNumbering.Active = False
            .Orientation = wdOrientLandscape
            .TopMargin = CentimetersToPoints(2)
            .BottomMargin = CentimetersToPoints(2)
            .LeftMargin = CentimetersToPoints(2)
            .RightMargin = CentimetersToPoints(2)
            .Gutter = CentimetersToPoints(0)
            .HeaderDistance = CentimetersToPoints(1.5)
            .FooterDistance = CentimetersToPoints(1.75)
            .PageWidth = CentimetersToPoints(29.7)
            .PageHeight = CentimetersToPoints(21)
            .FirstPageTray = wdPrinterDefaultBin
            .OtherPagesTray = wdPrinterDefaultBin
            .SectionStart = wdSectionNewPage
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .VerticalAlignment = wdAlignVerticalTop
            .SuppressEndnotes = False
            .MirrorMargins = False
            .TwoPagesOnOne = False
            .GutterPos = wdGutterPosLeft
            .LayoutMode = wdLayoutModeLineGrid
        End With
   
se1.TypeText Text:="20" & CStr(Date) & " " & CStr(Time())
If List2.ListCount = 0 Then
    Call Command6_Click
End If

doc.Tables.Add Range:=se1.Range, numrows:=1, numcolumns:=List2.ListCount
       
For i = 0 To List2.ListCount - 1
Screen.MousePointer = 11
'se1.TypeText Text:=rs.Fields(i).Name
se1.TypeText Text:=List2.List(i)
se1.MoveRight unit:=12
Next

'se1.TypeText Text:="产品名称"
'se1.MoveRight unit:=12

Do Until rs.EOF
 For i = 0 To List2.ListCount - 1
 On Error Resume Next
' se1.TypeText Text:=rs.Fields(i).Value
 se1.TypeText Text:=rs.Fields(List2.List(i)).Value
 se1.MoveRight unit:=12
 Next
'se1.TypeText Text:=rs!产品名称
'se1.MoveRight unit:=12

'se1.TypeText Text:=rs!中止
'se1.MoveRight unit:=12

rs.MoveNext
  
Loop
WordApp.Run MacroName:="AutoFitContent"
                 
     se1.InsertBreak
     se1.Delete Count:=List2.ListCount
   
   
    se1.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:= _
    wdAlignPageNumberRight, FirstPage:=True
    
 WordApp.Visible = True
  
' WordApp.Run MacroName:="InsertDateTime"
Set WordApp = Nothing
Screen.MousePointer = 1

End Sub

Private Sub Command3_Click()
'CrystalReport1.
End Sub

Private Sub Command4_Click()
Unload queryprintfrm
End Sub

Private Sub Command5_Click()
End
End Sub


Private Sub Command6_Click()
For i = 0 To List1.ListCount - 1 Step 1
    List2.AddItem List1.List(i)
    Next
    List1.Clear
    List2.SetFocus
    List2.Text = List2.List(0)
End Sub

Private Sub Command7_Click()
On Error Resume Next
         For i = 0 To List2.ListCount - 1 Step 1
         If List2.Selected(i) Then
            List1.AddItem List2.Text
            List2.RemoveItem (List2.ListIndex)
            Exit Sub
            End If
            Next
           
            List2.SetFocus
            List2.Text = List2.List(0)
           
            If List2.List(0) = "" Then
            List1.SetFocus
            List1.Text = List1.List(0)
            End If

End Sub

Private Sub Command8_Click()
For i = 0 To List2.ListCount - 1 Step 1
    List1.AddItem List2.List(i)
    Next
    List2.Clear
    List1.SetFocus
    List1.Text = List1.List(0)
End Sub

Private Sub Command9_Click()
On Error Resume Next
'On Error GoTo Errlist:
'Errlist:
'     If MsgBox("没有选定字段或所选字段不合要求,请重新选择字段再浏览!", vbOKOnly) = vbOK Then Exit Sub
    Dim ListStr As String
If List2.ListCount <> 0 Then
   For i = 0 To List2.ListCount - 1 Step 1
       If (i <> List2.ListCount - 1) Then
          ListStr = ListStr + List2.List(i) + ","
          Else
          ListStr = ListStr + List2.List(i)
          End If
        Next
    End If
    Me.Data1.RecordSource = "select" + " " + ListStr + " " + "from" + " " + Data1.Caption
    Me.Data1.Refresh
    Me.DBGrid1.Refresh
    Me.Refresh

End Sub

Private Sub ComSort_Click()
OrderStr = ComSort.Text
QueryData SqlString, OrderStr
End Sub

 

Function QueryData(ByVal SqlString As String, ByVal OrderStr As String) As String
On Error Resume Next
SqlString = SqlString + "order by " + " " + OrderStr
Data1.RecordSource = SqlString
'Data1.RecordSource = "select *from  order by name"
Data1.Refresh
DBGrid1.Refresh
Me.Refresh
End Function

 

Private Sub Form_Load()
On Error Resume Next

queryprintfrm.Data1.DatabaseName = datalistfrm.Text1.Text
queryprintfrm.Data1.RecordSource = datalistfrm.Combo1.Text
queryprintfrm.Caption = datalistfrm.Combo1.Text
queryprintfrm.Data1.Refresh
'Me.Data1.RecordSource = datalistfrm.Combo1.Text
'Me.Caption = datalistfrm.Combo1.Text
'Me.Data1.Refresh
For i = 0 To Data1.Recordset.Fields.Count - 1 Step 1
queryprintfrm.ComFind.AddItem Data1.Recordset.Fields(i).Name
queryprintfrm.ComSort.AddItem Data1.Recordset.Fields(i).Name
Me.List1.AddItem Data1.Recordset.Fields(i).Name
'Me.List2.AddItem Data1.Recordset.Fields(i).Name
Me.Combo1.AddItem Data1.Recordset.Fields(i).Name
Next
queryprintfrm.Refresh
For i = 0 To Data1.Recordset.Fields.Count - 1
DataType(i) = Data1.Recordset(i).Type
Next

'error:
'MsgBox "数据库文件出错,请重新选择数据库!"


End Sub

Private Sub List1_DblClick()
Call Command1_Click

End Sub

 


Private Sub List2_DblClick()
Call Command7_Click
End Sub

Private Sub open_Click()
   Call Command10_Click
End Sub

json 输出到 table

最近在写前端,无论大小知识点,都来给我的博客添块砖吧。 话不多说其实就是一个简单的js  的for循环 js代码: $(function(){ var str=[{name:"zy",age:...
  • zhang1088632743
  • zhang1088632743
  • 2017年09月08日 10:11
  • 125

如何用vb将计算结果输出到word中?

 我想通过保存按钮将文本框中的文字输出到word文档中,开始运行的很好,但后来改动界面后不知怎么不行了。同样的代码在word宏中也是有时可以运行,有时就进行不下去。请大侠多指教!程序界面和程序编辑界面...
  • vbptau
  • vbptau
  • 2007年12月08日 21:21
  • 1013

excel表格输出到word中的一种方法

网上搜了一些方法介绍,其中一种是用邮件合并功能,没看明白。目前的应用场景,经常需要把excel里头的几张财务报表,作为附表拷贝到word报告中,每次复制粘贴后,格式都变了,用“仅保留文本”的粘贴方式也...
  • luocm
  • luocm
  • 2012年05月07日 12:49
  • 6046

DBF文件输出到WORD

Private i As IntegerPrivate MacroName As StringPrivate WordApp As Word.ApplicationPrivate doc As Wor...
  • cwxiao888
  • cwxiao888
  • 2004年02月17日 18:46
  • 1126

小技巧之js导出word

js导出word方法,简单,但是功能上要弱一些   function copyTable(){  //tabel、div ID, 会将table内所有的内//容复制到word  var elTab...
  • fly_yuge
  • fly_yuge
  • 2015年12月22日 17:39
  • 2160

06毕业设计 - VB导出word文档

Private Sub docout_Click()       '导出WORD按钮  If rs1.RecordCount   MsgBox "导出失败,当前列表中没有记录!"  outstate1...
  • limshirley
  • limshirley
  • 2017年04月17日 14:15
  • 753

存储BITMAP到文件

GDI中位图对象是很常见的GDI对象,但是无论是SDK,还是MFC都没有提供现在的函数或是方法来将一个位图对象保存为一个BMP文件,这里介绍一下保存方法。位图文件格式:DIB文件有四个主要部分:文件表...
  • SunnyWinters
  • SunnyWinters
  • 2010年03月03日 16:42
  • 1951

C# 快速导出word

StreamWriter writer = new StreamWriter("D:\a.doc”, false, Encoding.GetEncoding("gb2312")); ...
  • happy09li
  • happy09li
  • 2013年03月05日 11:16
  • 4797

vs2008导出word实例

VS2008导出word实例,有图有真相...... 操作系统:win7 office word版本:2010 程序类型:基于对话框的MFC应用程序...
  • VictoryKNight
  • VictoryKNight
  • 2014年02月22日 11:13
  • 1488

读mdb数据库中的表,返回datatable;链接postgresql数据库,读取数据库中表

public DataTable ReadMDB(string mdbFile,string tableName) { string connStr = "Pr...
  • u013779141
  • u013779141
  • 2016年11月18日 15:57
  • 440
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:MDB之Table输出到Word
举报原因:
原因补充:

(最多只允许输入30个字)