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.

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
Task