Kolay gelsin.
"Dünyayı fazla düşünme."
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