Skip to main content

AccessTr.neT


Accessten Worde Aktarırken Bazı Satırların Koyu Renkli Yazılması

Accessten Worde Aktarırken Bazı Satırların Koyu Renkli Yazılması

Çözüldü #1
Merhaba. Ekteki dosyada frm_malzemeler formundaki Liste2 de yer alan malzemelere ait teknik özellikleri Teknik İstekler butonu ile ms worde aktarırken malzeme isimlerinin ve bu malzeme isimlerine denk gelen sıra numaralarının (örneğin; 1. KROM KAP, UZUN MUSLUK 1/2") koyu renkli olarak görülmesini nasıl sağlayabilirim?
.rar MALZEMELER6_7.rar (Dosya Boyutu: 87,3 KB | İndirme Sayısı: 6)
Son Düzenleme: 31/12/2017, 00:50, Düzenleyen: mmert06.
Cevapla
#2
İnceleyip olumlu/olumsuz bildirimde bulununuz.
.rar MALZEMELER6_7_wordeaktar_sld.rar (Dosya Boyutu: 77,23 KB | İndirme Sayısı: 14)
Cevapla
#3
ozan bey gerçekten ellerinize sağlık güzel olmuş faka t incelerken küçük bir sorunla karşılaştım şöyle;
Liste2 ye bir tane malzeme eklediğimde resim-1 de görüldüğü gibi 1.2. sıra nolu teknik özellik worde aktarılmamış gözüküyor
resim-1
[Resim: do.php?imgf=15147171937711.png]
Liste2 ye iki tane malzeme eklediğimde resim-2 de görüldüğü gibi 1.2. sıra nolu teknik özellik worde aktarılırken bu sefer 2.2. sıra nolu teknik özelliğin worde aktarılmamış olduğu görülüyor
resim-2
[Resim: do.php?imgf=151471733885671.png]
sıra numarasındaki bu sorun nasıl düzeltilebilir? Son olarak öğrenmek ve bundan sonraki çalışmalarımda kullanmak istedğim için bu örnekte worde aktarılırken ne tür bir işlem uygulandığını anlatırsanız sevinirim. Saygılar.
Cevapla
#4
Fonksiyonu aşağıdaki ile değiştirerek deneyiniz.

Visual Basic Code
Function Export2DOC(sQuery As String)
    Dim oWord           As Object
    Dim oWordDoc        As Object
    Dim oWordTbl        As Object
    Dim bWordOpened     As Boolean
    Dim db              As DAO.Database
    Dim rs              As DAO.Recordset
    Dim iCols           As Integer
    Dim iRecCount       As Integer
    Dim iFldCount       As Integer
    Dim i               As Integer
    Dim j               As Integer
    Const wdPrintView = 3
    Const wdWord9TableBehavior = 1
    Const wdAutoFitFixed = 0
    On Error Resume Next
    Set oWord = GetObject("Word.Application")
 

   If Err.Number <> 0 Then
        Err.Clear
 
        Set oWord = CreateObject("Word.application")
        bWordOpened = False
    Else
        bWordOpened = True
    End If
    On Error GoTo Error_Handler
    oWord.Visible = True
    Set oWordDoc = oWord.Documents.Add
 
    Set db = CurrentDb
    Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
    With rs
        If .RecordCount <> 0 Then
            .MoveLast
            iRecCount = .RecordCount ' sorgu satır sayısı
            .MoveFirst
            iFldCount = .Fields.Count ' sorgu sütun sayısı
 
            oWord.ActiveWindow.View.Type = wdPrintView
            oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=iRecCount + 1, NumColumns:= _
                                            iFldCount, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
                                            wdAutoFitFixed 'satır sayısının 1 fazlası ve sütun sayısına göre tablo oluştur
                                                        
 
            Set oWordTbl = oWordDoc.Tables(1)
           
                oWordTbl.Cell(1, 1) = "SIRA NO" 'tablonun 1. satır 1. sütuna yazılan veri
                oWordTbl.Cell(1, 3) = "TEKNİK İSTEKLER" 'tablonun 1. satır 3. sütuna yazılan veri
                oWordTbl.Cell(1, 1).Range.Font.Bold = True
                oWordTbl.Cell(1, 3).Range.Font.Bold = True '1. satır 3. sütun kalın yazı

            For i = 1 To iRecCount
                For j = 0 To iFldCount - 1

                oWordTbl.Cell(i + 1, j + 1) = Nz(rs.Fields(j).Value, "") 'satır sayısı ve sütun sayısına göre oluşturulan döngüde tablodaki hücrelere aktarılan veri
                    
                    If j = 1 And rs.Fields(j).Value = 0 Then ' j 1 ise ve değer 0 ise satırı kalın yazı yap
                                    
                    oWordDoc.Tables(1).Cell(i + 1, j).Range.Font.Bold = True
                    oWordDoc.Tables(1).Cell(i + 1, j + 1).Range.Font.Bold = True
                    oWordDoc.Tables(1).Cell(i + 1, j + 2).Range.Font.Bold = True
                                   
                    End If
                    
                Next j
                .MoveNext
            Next i
            oWordTbl.Columns(1).Width = (50) '1 sütunun genişliği
            oWordTbl.Columns(3).Width = (400) ' 3.sütunun genişliği
            oWordTbl.Columns(2).Delete ' 2. sütunu sil (S2 sütunu)
            
        Else
            MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Word spreadsheet with"
            GoTo Error_Handler_Exit
        End If
    End With
    
 
Error_Handler_Exit:
    On Error Resume Next
    oWord.Visible = True
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set oWordTbl = Nothing
    Set oWordDoc = Nothing
    Set oWord = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Export2DOC" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function
Cevapla
#5
module1 deki kodları mı bununla değiştireceğim?
Cevapla
#6
Fonksiyon olarak belirttiğim kod, mesajda da belirttiğim Export2DOC fonksiyondur.

Bu fonksiyon nerede ise onu değiştireceksiniz.
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da