Skip to main content

AccessTr.neT


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

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

#25
Kolay gelsin.
"Dünyayı fazla düşünme."
Cevapla
#26
sn userx,
çok teşekkür ederim,
sizede kolay gelsin.
husem, proud to be a member of AccessTr.neT since 08-03-2009.
Cevapla
#27
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
.rar Access_Rapor_Excele.rar (Dosya Boyutu: 57,75 KB | İndirme Sayısı: 5)
Cevapla
#28
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,
husem, proud to be a member of AccessTr.neT since 08-03-2009.
Cevapla
#29
Iyi çalışmalar
Kolay gelsin
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task