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?

İnceleyip olumlu/olumsuz bildirimde bulununuz.

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

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

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.

Fonksiyonu aşağıdaki ile değiştirerek deneyiniz.

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

module1 deki kodları mı bununla değiştireceğim?

Fonksiyon olarak belirttiğim kod, mesajda da belirttiğim Export2DOC fonksiyondur.

Bu fonksiyon nerede ise onu değiştireceksiniz.