Question

vb调用excel模板进行打印

想实现一个功能，点击打印按钮，调用 dy.xls 的excel模板进行打印。
DataGrid1控件中显示的有“政治面貌”一项，打印模板中 没有 “政治面貌”一项
数据从第四行开始
请教前辈，怎么编写！~
数据库是用的access数据库





Answer 1

Sub outputExcel() 
On Error GoTo merr 
Dim a As Object 
Set a = CreateObject("Excel.Application") 
a.visible = True 
Dim w As Object 
Set w = a.Worksheets("sheet1") 
Dim s() As String 
Dim ns As Integer 
ns = 10 
ReDim s(ns - 1) 
Dim col As Integer 
Dim f As Field, title As String 
Dim tmp1 As Variant, tmp2 As Variant 
Dim fieldName As String 
With de1.rsselTmpReport 
   If .RecordCount > 0 Then 
        col = 0 
          de1.rsexcel.MoveFirst 
          Do While Not de1.rsexcel.EOF 
              If de1.rsexcel.Fields("isprint").Value Then 
                If LANG = 0 Then 
                    title = de1.rsexcel.Fields("title").Value 
                Else 
                    title = de1.rsexcel.Fields("title_en").Value 
                End If 
                col = col + 1 
                w.Cells(Count + 3, col).Value = title 
                w.Cells(Count + 3, col).HorizontalAlignment = -4108 
                w.Cells(Count + 3, col).VerticalAlignment = -4108 
              End If 
              de1.rsexcel.MoveNext 
          Loop 
    w.range("A1:" + IntToLetter(col - 1) + "1").Select 
    a.Selection.Merge 
      .MoveFirst 
      While Not .EOF 
        col = 0 
          de1.rsexcel.MoveFirst 
          Do While Not de1.rsexcel.EOF 
              If de1.rsexcel.Fields("isprint").Value Then 
                title = de1.rsexcel.Fields("title").Value 
                col = col + 1 
                If de1.rsexcel.Fields("fieldname").Value = "crsd" Then 
                    'maybe str , val() 
                    If Not IsNull(.Fields("cstd")) Then 
                    tmp1 = myFieldValue(.Fields("cstd")) 
                    tmp1 = Val(tmp1) 
                    tmp2 = myFieldValue(.Fields("c")) 
                    tmp2 = Val(tmp2) 
                    w.Cells(Count + 4, col).Value = myDiv(tmp1, tmp2) 
                    End If 
                ElseIf de1.rsexcel.Fields("fieldname").Value = "srsd" Then 
                    If Not IsNull(.Fields("sstd")) Then 
                    tmp1 = myFieldValue(.Fields("sstd")) 
                    tmp1 = Val(tmp1) 
                    tmp2 = myFieldValue(.Fields("s")) 
                    tmp2 = Val(tmp2) 
                    w.Cells(Count + 4, col).Value = myDiv(tmp1, tmp2) 
                    End If 
                Else 
                    fieldName = de1.rsexcel.Fields("fieldname").Value 
                    tmp1 = myFieldValue(.Fields(fieldName)) 
                    w.Cells(Count + 4, col).Value = tmp1 
                End If 
                w.Cells(Count + 4, col).HorizontalAlignment = -4108 
                w.Cells(Count + 4, col).VerticalAlignment = -4108 
                Select Case de1.rsexcel.Fields("fieldname").Value 
                  Case "c", "s", "cstd", "sstd", "weight": 
                    w.Cells(Count + 4, col).NumberFormat = "0.0000" 
                  Case "crsd", "srsd" 
                    w.Cells(Count + 4, col).NumberFormat = "0.0%" 
                End Select 
              End If 
              de1.rsexcel.MoveNext 
          Loop 
            Count = Count + 1 
           .MoveNext 
      Wend 
   End If 
End With 
w.range("A3:" + IntToLetter(col - 1) + CStr(Count + 4 - 1)).Select 
a.Selection.Borders(7).LineStyle = 1 
a.Selection.Borders(7).weight = 2 
a.Selection.Borders(7).ColorIndex = -4105 
a.Selection.Borders(8).LineStyle = 1 
a.Selection.Borders(8).weight = 2 
a.Selection.Borders(8).ColorIndex = -4105 
 
a.Selection.Borders(9).LineStyle = 1 
a.Selection.Borders(9).weight = 2 
a.Selection.Borders(9).ColorIndex = -4105 
a.Selection.Borders(10).LineStyle = 1 
a.Selection.Borders(10).weight = 2 
a.Selection.Borders(10).ColorIndex = -4105 
a.Selection.Borders(11).LineStyle = 1 
a.Selection.Borders(11).weight = 2 
a.Selection.Borders(11).ColorIndex = -4105 
a.Selection.Borders(12).LineStyle = 1 
a.Selection.Borders(12).weight = 2 
a.Selection.Borders(12).ColorIndex = -4105 
w.Cells.Select 
a.Selection.Columns.AutoFit 
Exit Sub 
merr: 
saveerrmsg 
End Sub

从我的程序中截取的部分代码供你参考。