產生Excel進階報表

前不久行裡說要產生一個如下的Excel報表,試了很多種方法都不行,突然想到excel引用,宏,試寫了下,發現效果不錯.

各位可以參考此方法產生任意格式的Excel,可能很多人直接用程式來一行行的寫,想想這是多複雜的事情啊,想設定Excel格式就更加複雜了.而且程式迴圈效率也極慢,照我方法可以直接下載後就直接列印,格式全部已設定好.好了,廢話不多說,覺得好用多多推廣,轉載請注示一下來自http://www.cnbolgs.com/xiaobier,謝謝.以下是產生後的:

我這裡用的資料庫是SQL server.說一下思路:

先製作一個excel樣式,如,我這裡標題是固定的,部門和日期是動態,列名是固定的,中間那塊資料是動態,部門考勤員名字是動態,其他都是靜態.

把樣式先做好.以是我先做好的樣式:

8,9為什麼要留兩行,是為了第10行的統計函數設定,合計那行是已經設定好excel公式的,如C10是Sum(C8:C9)依此類推,如果往8,9中間插入行那excel

會自動擴充第10行的公式,如原是Sum(C8:C9)那插入一行就自動變成sum(C8:C10),這個大家應該都知道.而且往8,9中間插入行他的格式是根前一行

相同的,所以就這裡就設定好了動態資料區的格式了.其他幾個地方也是一樣.

第三行的日期我是讓他引用sheet2中的A2,部門是B2,考勤員是C2

是Sheet2,其中sheetdate,department,oper是列名,用來向sheet2這三個欄位插入記錄的

中的主要資料區我是放在sheet3中,以下是sheet3樣式,同樣是列名,以中是對應的.

sheet2隻有一條記錄,所以直接在sheet1對應處引用即可,如何讓sheet1中引用sheet3中的資料,因為sheet3中的記錄是動態,

也不知道有多少行,所以要利用宏了.寫宏其實也很簡單,我這裡也沒寫多少行代碼.

 

Code

Sub Macro1()
'
' Macro1 Macro
' 宏由 XiaoBier 錄製，時間: 2008-9-24
'
' 快速鍵: Ctrl+q
'

Dim i As Integer
Dim count As Integer
Dim rownum As Integer
count = Sheet3.UsedRange.Rows.count - 1 '這裡是擷取sheet3中的記錄行數,減掉列名首行

Sheets("Sheet1").Select  '選中sheet1

'在sheet1中的8和9行之間插入行數
For i = 3 To count Step 1
    Sheet1.Range("A9").Select
        Selection.EntireRow.Insert
Next i

rownum = 1

'將sheet1中資料行引用sheet3中的資料
For i = 8 To count + 7 Step 1

    Range("A" & i) = rownum
    
    Range("B" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Sheet3!R[-6]C[-1],"""")"
    
    Range("C" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("D" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("E" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("F" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("G" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("H" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("I" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("J" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("K" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("L" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("M" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("N" & i).FormulaR1C1 = "=IF(Sheet3!R[-6]C[-1]>0,Value(Sheet3!R[-6]C[-1]),"""")"
    
    Range("O" & i) = Null
    rownum = rownum + 1
Next i

End Sub

'這個子程式讓一開啟excel就自動調用宏
Sub auto_open()
Call Macro1
End Sub

是不是很簡單,如果你不會寫宏就錄製吧,要什麼操作就錄製.然後把錄製的代碼copy下來就可以了.

樣式檔案建好.要產生excel的時候調用System.IO.File.Copy複製成目標名.沒有其他動作.

接著是利用SQl openrowset往目標檔案名的sheet3,和sheet2插入記錄.

 

Code
set @sql='openrowset(''MICROSOFT.JET.OLEDB.4.0'',''Excel 8.0;HDR=YES ;DATABASE='+@path+@fname+''',[sheet3$])' 
             exec('insert into '+@sql+'(name,late,patient,privacy,cyesis,suckle,children,relatives,delay,rest,law,adjust,year) select * from #sheetrst3')

--注意上面的列名好和sheet3中是對應的
 set @sql='openrowset(''MICROSOFT.JET.OLEDB.4.0'',''Excel 8.0;HDR=YES;DATABASE=' +@path+@fname+''',[sheet2$])' 
exec('insert into '+@sql+'(sheetdate,department,oper) select '''+@date+''','''+@deptname+''','''+@operator+'''')

 

大功告成...