Skip to main content

AccessTr.neT


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

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

Çözüldü #1
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?
Cevapla
#2
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.

Visual Basic Code
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
Cevapla
#3
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?
Cevapla
#4
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?
Cevapla
#5
Benim yaptığım denemelerde herhangi bir sorun görünmüyor. Uygulamanızın son halini eklerseniz test ederek inceleyebilirim.
"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 
Cevapla
#6
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?
.rar olay.rar (Dosya Boyutu: 341,78 KB | İndirme Sayısı: 1)
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da