Not: Tmp.xlsx adında şablon bir Excel oluşturuldu, eğer bu dosyada değişiklik yaparsanız değişiklikler sonradan oluşturulacak tüm dosyalara da yansır.
excele gönder butonuna her bastığınızda veriler Tmp şablon dosyasına eklenip iş bitince yükleme listesi.xlsx dosyası olarak kaydediliyor
Tmp dosyası ile Access dosyanız aynı dizinde olacak şekilde ayarlandı isterseniz değiştirirsiniz.
Raporu Excele Aktarma Kodu
Private Sub excel_yaz_Click()
Dim Sql As String
xAdrsHdf = "d:\Desktop\Access_Rapor_Excel\Tmp.xlsx"
Dim rs As New ADODB.Recordset
SQL = "SELECT " & _
"YUKLEME_LISTESI.MUSTERI_SIP_NO AS [Order], " & _
"YUKLEME_LISTESI.ARTICLE_NO AS [Article No], " & _
"YUKLEME_LISTESI.URUN_TANIMI AS [Good Identification], " & _
"YUKLEME_LISTESI.MUSTERI_RENK_NO AS Colour, " & _
"YUKLEME_LISTESI.En AS [Size W], " & _
"YUKLEME_LISTESI.Boy AS [Size L], " & _
"YUKLEME_LISTESI.Gramaj AS GSM, " & _
"YUKLEME_LISTESI.KOLI_NO AS [Carton Number], " & _
"YUKLEME_LISTESI.ADET AS [Total Qty], " & _
"YUKLEME_LISTESI.KOLI_ADEDI AS [Total Carton], " & _
"YUKLEME_LISTESI.KOLI_ICI AS [Qty in Carton], " & _
"YUKLEME_LISTESI.GR_ADET AS [Gr-pcs], " & _
"YUKLEME_LISTESI.KOLI_AGIRLIK AS [Total Carton Weight], " & _
"YUKLEME_LISTESI.BIRIM_FIYAT AS [Unit Price €], " & _
"YUKLEME_LISTESI.TOP_TUTAR AS [Total Price €], " & _
"YUKLEME_LISTESI.HACIM_M3 AS m³, " & _
"YUKLEME_LISTESI.KOLI_EBADI AS [Carton Size] " & _
"FROM YUKLEME_LISTESI " & _
"WHERE (((YUKLEME_LISTESI.YUKLEME_NO)='" & Me.YUKLEME_NO & "')) ORDER BY YUKLEME_LISTESI.ID"
rs.CursorLocation = adUseClient
rs.Open SQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Z = rs.RecordCount - 1
Const xlOpenXMLWorkbook = 51
Dim xlApp As Object
Dim xlBook As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xAdrsHdf = CurrentProject.Path & "\Tmp.xlsx"
sFilePath2 = CurrentProject.Path & "\yükleme listesi.xlsx"
Set xlBook = xlApp.Workbooks.Open(xAdrsHdf)
If Dir(sFilePath2) <> "" Then
Kill (sFilePath2) 'Delete (strPath)
End If
I = 4
Set SYF = xlBook.Worksheets("Sayfa1")
With SYF
.Range("A" & I).CopyFromRecordset rs
With .Range("A" & I & ":Q" & Z + I).Borders
.LineStyle = xlDashDotDot
.Weight = xlThin
' .ColorIndex = 3
End With
If Z < 1 Then Z = 0
.Range("A" & I, "Q" & Z + I).Font.Size = 9
.Range("A" & I, "Q" & Z + I + 1).HorizontalAlignment = xlCenter
.Range("N" & I, "O" & Z + I).NumberFormat = "€ " & "#,###.00"
.Range("N" & I, "O" & Z + I).Font.Color = vbRed
.Range("N" & I, "O" & Z + I).Font.Size = 12
.Range("G" & Z + I + 1) = "Toplam :"
.Range("G" & Z + I + 1 & ":P" & Z + I + 1).Interior.ColorIndex = 6
.Range("M" & Z + I + 1).NumberFormat = "#,###.00" 'G=Toplam & "O" & Z + I + 1
.Range("O" & Z + I + 1).NumberFormat = "€ " & "#,###.00"
.Range("I" & Z + I + 1).Formula = "=Sum(I4:I" & Z + I & ")"
.Range("J" & Z + I + 1).Formula = "=Sum(J4:J" & Z + I & ")"
.Range("M" & Z + I + 1).Formula = "=Sum(M4:M" & Z + I & ")"
.Range("O" & Z + I + 1).Formula = "=Sum(O4:O" & Z + I & ")"
.Range("P" & Z + I + 1).Formula = "=Sum(P4:P" & Z + I & ")"
End With
xlBook.SaveAs sFilePath2, xlOpenXMLWorkbook
xlBook.Saved = True
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox "İşlem Tamam"
End Sub
