Raporu Logolu Ve Biçimlendirilmiş Olarak Excel'e Gönderme

1 2 3 4 5
05/02/2022, 12:11

userx

Kolay gelsin.
05/02/2022, 12:16

husem

sn userx,
çok teşekkür ederim,
sizede kolay gelsin.
06/02/2022, 00:53

berduş

aşağıdaki dosyayı inceler misiniz.
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
06/02/2022, 13:37

husem

sn userx ve sn halil üstadım,
yardımlarınız için çok teşekkür ederim,
iki örnekte çok güzel,

faklı yollarla nasıl yapılacağını öğrenmiş oldum,
ayrıca konu devam ederken, yaptığım araştırmalarda Access sorgu sonucunu döngü ile kayıtlı bir Excel dosyasına nasıl aktaracağımı da öğrenmiş oldum.

sn userx üstadımın örneği bana daha kullanışlı geldi, sayfa ayarları yapılmış tek birdosya, accessden gönderme işlemi sonrasında hazır tek bir Excel dosyası,
sn halil üstadımın örneğinde iki Excel dosyası var, bir tanesi referans dosya, farklı kullanıcıların kullanımında bu örnek sıkıntı oluşturabilir, referans dosya "tmp.xlsx" dosyasının amacını bilmeyen bir kullanıcı silebilir,

ama iki örnekte benim için bilgilendirici oldu,
çok teşekkür ederim,
Allah razı olsun,
06/02/2022, 13:46

berduş

Iyi çalışmalar
Kolay gelsin
1 2 3 4 5