Zengin Metin Alanındaki Biçim Özellikleri Worde Aktarma

Formumuzdaki zengin metin alanındaki yazı stili, renk gibi biçimsel özellikleri Worde aynı şekilde aktarabiliyor muyuz?Denemelerimde mesela metin alanında kırmızı renkle yazılmış "metin" ifadesini " <font color=red>metin</font>" şeklinde worde aktarıyor.Metin alanındaki bilgileri aynı şekilde worde aktarmak mümkün mü ?Kodlarla gerçekleştirilebilir mi?

Formdan Word Dosyasına Aktarma Sorunu bağlantısındaki konunuzda bulunan örnekten bahsediyorsar;

Butonun tıklandığında olayındaki kodun tamamını aşağıdaki ile değiştirerek deneyin.

Dim Kayit As DAO.Recordset

Dim GKlasor, GDosyaNo, GDosyaYolu, GSablon, GeciciBelgeAdi As String

Dim ResimBilgisi, ResimBilgisi2, ResimBilgisi3, ResimBilgisi4 As Variant

Dim ResimAdi, ResimAdi2, ResimAdi3, ResimAdi4 As String

Dim AcikBelgeResim, AcikBelgeResim2, AcikBelgeResim3, AcikBelgeResim4 As Variant

Dim WordApp As Word.Application

Dim IFADEHTML, GelenBilgiHTML As String



GKlasor = Environ("TEMP")

GDosyaNo = Format(Now(), "ddmmyyyyhhnnss")

GDosyaYolu = GKlasor & "\AccessTrneT" & GDosyaNo & "\"

GSablon = CurrentProject.Path & "\format1.docx"



If FolderExists(GDosyaYolu) = False Then

    MkDir GDosyaYolu

End If



Set Kayit = CurrentDb.OpenRecordset("SELECT * FROM kimlikbilgileri WHERE (((sira)=" & Me.mtn_sira & "))")



    

Do While Not Kayit.EOF



GeciciBelgeAdi = CurrentProject.Path & "\" & Format(Kayit.Fields("ADI").Value) & ".docx"



    Set ResimBilgisi = Kayit.Fields("FOTOgRAF_1").Value

        While Not ResimBilgisi.EOF

            ResimAdi = GDosyaYolu & "a1a" & ResimBilgisi.Fields("FileName")

            ResimBilgisi.Fields("FileData").SaveToFile ResimAdi

            ResimBilgisi.MoveNext

        Wend

    Set ResimBilgisi2 = Kayit.Fields("FOTOgRAF_2").Value

        While Not ResimBilgisi2.EOF

            ResimAdi2 = GDosyaYolu & "b1b" & ResimBilgisi2.Fields("FileName")

            ResimBilgisi2.Fields("FileData").SaveToFile ResimAdi2

            ResimBilgisi2.MoveNext

        Wend

    Set ResimBilgisi3 = Kayit.Fields("FOTOgRAF_3").Value

        While Not ResimBilgisi3.EOF

            ResimAdi3 = GDosyaYolu & "c1c" & ResimBilgisi3.Fields("FileName")

            ResimBilgisi3.Fields("FileData").SaveToFile ResimAdi3

            ResimBilgisi3.MoveNext

        Wend

    Set ResimBilgisi4 = Kayit.Fields("FOTOgRAF_4").Value

        While Not ResimBilgisi4.EOF

            ResimAdi4 = GDosyaYolu & "d1d" & ResimBilgisi4.Fields("FileName")

            ResimBilgisi4.Fields("FileData").SaveToFile ResimAdi4

            ResimBilgisi4.MoveNext

          

        Wend





'    Set WordApp = GetObject(, "Word.Application")

    

'    If Err.Number <> 0 Then

        Set WordApp = CreateObject("Word.Application")



'    End If

     

        WordApp.Visible = True

        WordApp.WindowState = wdWindowStateMaximize

        WordApp.Documents.Add Template:=GSablon, NewTemplate:=False



        With WordApp



                .Selection.GoTo What:=wdGoToBookmark, Name:="ad"

                .Selection.TypeText Nz(Kayit.Fields("ADI"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="soyad"

                .Selection.TypeText Nz(Kayit.Fields("SOYADI"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="tc"

                .Selection.TypeText Nz(Kayit.Fields("tc"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="dogumyer"

                .Selection.TypeText Nz(Kayit.Fields("DOGUM_YER"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="dogumtrh"

                .Selection.TypeText Nz(Kayit.Fields("DOGUM_TARIH"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="olaytrh"

                .Selection.TypeText Nz(Kayit.Fields("OLAYTARIH"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="gorevyer"

                .Selection.TypeText Nz(Kayit.Fields("GOREVYER"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="gorev"

                .Selection.TypeText Nz(Kayit.Fields("GOREVI"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="annead"

                .Selection.TypeText Nz(Kayit.Fields("ANNEADI"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="babaad"

                .Selection.TypeText Nz(Kayit.Fields("BABAADI"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="nufus"

                .Selection.TypeText Nz(Kayit.Fields("KUTUK"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="adres"

                .Selection.TypeText Nz(Kayit.Fields("AILEADRES"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="aranma"

                .Selection.TypeText Nz(Kayit.Fields("ARANMA"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="durum"

                .Selection.TypeText Nz(Kayit.Fields("DURUMU"), "")

                .Selection.GoTo What:=wdGoToBookmark, Name:="adli"

                .Selection.TypeText Nz(Kayit.Fields("ADLIKAYIT"), "")

                

                    IFADEHTML = GKlasor & "\IFADEHTML.html"

                    Open IFADEHTML For Output As 1

                    Print #1, "<HTML>" & Nz(Kayit.Fields("IFADE"), "") & "</HTML>"

                    Close #1

                    

                .Selection.GoTo What:=wdGoToBookmark, Name:="ifade"

                .Selection.InsertFile FileName:=IFADEHTML, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False

                

                

                    GelenBilgiHTML = GKlasor & "\GELENBILGI.html"

                    Open GelenBilgiHTML For Output As 1

                    Print #1, "<HTML>" & Nz(Kayit.Fields("GELENBILGI"), "") & "</HTML>"

                    Close #1

                

                

                .Selection.GoTo What:=wdGoToBookmark, Name:="gelen"

                .Selection.InsertFile FileName:=GelenBilgiHTML, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False

                



'/////resimler

                If Len(ResimAdi) > 0 Then

                

                .Selection.GoTo What:=wdGoToBookmark, Name:="res1"

                Set AcikBelgeResim = .Selection.InlineShapes.AddPicture(FileName:=ResimAdi, LinkToFile:=True, SaveWithDocument:=True)

                

                With AcikBelgeResim

                    .LockAspectRatio = msoTrue

                    .Height = 110

                    .Width = 90

                End With

                

                End If

                

                If Len(ResimAdi2) > 0 Then

                .Selection.GoTo What:=wdGoToBookmark, Name:="res2"

                Set AcikBelgeResim2 = .Selection.InlineShapes.AddPicture(FileName:=ResimAdi2, LinkToFile:=True, SaveWithDocument:=True)

                

                With AcikBelgeResim2

                    .LockAspectRatio = msoTrue

                    .Height = 110

                    .Width = 90

                End With

                

                End If

                

                If Len(ResimAdi3) > 0 Then

                

                .Selection.GoTo What:=wdGoToBookmark, Name:="res3"

                

                Set AcikBelgeResim3 = .Selection.InlineShapes.AddPicture(FileName:=ResimAdi3, LinkToFile:=True, SaveWithDocument:=True)

                

                With AcikBelgeResim3

                    .LockAspectRatio = msoTrue

                    .Height = 110

                    .Width = 90

                End With

                

                End If

                

                If Len(ResimAdi4) > 0 Then

                

                .Selection.GoTo What:=wdGoToBookmark, Name:="res4"

                Set AcikBelgeResim4 = .Selection.InlineShapes.AddPicture(FileName:=ResimAdi4, LinkToFile:=True, SaveWithDocument:=True)

                

                With AcikBelgeResim4

                    .LockAspectRatio = msoTrue

                    .Height = 110

                    .Width = 90

                End With

                

                End If

             



            WordApp.ActiveDocument.SaveAs2 (GeciciBelgeAdi)

            WordApp.Documents.Close False

            WordApp.Quit





        Set WordApp = Nothing



                

        End With



    Kayit.MoveNext

Loop



If FileExists(GeciciBelgeAdi) = True Then

    

    If MsgBox("Oluşturulan " & GeciciBelgeAdi & " isimli dosya açılsın mı?", vbYesNo, "Belge Aç") = vbYes Then

      

        Set WordApp = New Word.Application

            With WordApp

                .Visible = True

                .WindowState = wdWindowStateMaximize

                .Documents.Open (GeciciBelgeAdi)

            End With

    End If



End If

Teşekkür ederim Ozan Hocam.Eline emeğine sağlık.Sorunsuz çalıştı.Son bir sorum olacak.Örneğimdeki durum alanında birleşik giriş kutusu kullanmıştım.Buna koşullu biçimlendirme uyguladım."Kayıt var"  ifadesi kırmızı "kayıt yok" ifadesi mavi renkte veya herhangi bir renkte worde aktarabilir miyiz?

Ozan hocam birde deneme yaparken ifadelerde bulunan türkçe karakterler worde aktarıldığında hatalı geliyor.Dİl seçeneklerini kontrol ettim.Farklı yazı stilleriyle de denedim ama olmadı.Ne yapmak gerekir?

Benim yaptığım denemelerde herhangi bir sorun görünmüyor. Uygulamanızın son halini eklerseniz test ederek inceleyebilirim.

Tekrar denedim şuan.Karakter sorunu düzeldi Ozan hocam.Herhangi bir sorun görünmüyor.Son olarak formdaki durumu alanındaki birleşik giriş kutusunda koşullu biçimlendirme uyguladım. "kayıt var" ifadesi kırmızı,"kayıt yok" ifadesi mavi renkte veya herhangi bir renkte worde aktarabilir miyiz?