+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html)
+--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Zengin Metin Alanındaki Biçim Özellikleri Worde Aktarma (/konu-zengin-metin-alanindaki-bicim-ozellikleri-worde-aktarma.html)
Sayfalar:
1
2
Zengin Metin Alanındaki Biçim Özellikleri Worde Aktarma - suayip - 09/04/2020
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?
Cvp: Zengin Metin Alanındaki Biçim Özellikleri Worde Aktarma - ozanakkaya - 09/04/2020
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 IfRE: Zengin Metin Alanındaki Biçim Özellikleri Worde Aktarma - suayip - 10/04/2020
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?
RE: Zengin Metin Alanındaki Biçim Özellikleri Worde Aktarma - suayip - 10/04/2020
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?
RE: Zengin Metin Alanındaki Biçim Özellikleri Worde Aktarma - ozanakkaya - 10/04/2020
Benim yaptığım denemelerde herhangi bir sorun görünmüyor. Uygulamanızın son halini eklerseniz test ederek inceleyebilirim.
RE: Zengin Metin Alanındaki Biçim Özellikleri Worde Aktarma - suayip - 10/04/2020
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?