font rengi, boyutu, tipi

[vivident]

Merhaba

Excelden Outlooka bir metin gönderiyorum. Metin gövdesinde (yazı tipi, boyutu, ve renginde) değişiklik yapmak istiyorum ama bir türlü olmuyor

Örneğin Denediğim Kodlar ;

"<font face=arial>gözükmesini istediğiniz metin</font>"

"<p style='color:rgb(238,0,0);font-family:Tahoma;font-size:11'>" & "gözükmesini istediğiniz metin" & "</font>"

Ayrıca bir alt satırı geçmede de problem oldu
metnin sonunsa <br> eklediğimde olmuyor, lakin chr(13) ekleyince veya "vbCr" ekleyince bir alt satıra geçiyor

Fikri olan varmıdır ?

 

[antonio]

Merhaba,
Görüntülediğiniz kod aralığını daha geniş tutarsanız, daha iyi fikir yürütülebilir.

 

[Asri]

Mail biçimi html mi? .htmlbody
Mail biçimi text mi? .body

 

[vivident]

dosyam ektedir
kırmızı fontlu kodları denedim, Outlook takviminde görüntülenince kodlarda çıkıyor. Aşağıdaki gibi bir metin çıkıyor

"<p> <font size=2 color=red face=Tahoma>" & _
"Gözükmesini istediğiniz metin-1" & "<br>" & _
"Gözükmesini istediğiniz metin-2" & _
"</font> </p>"

Private Sub CommandButton1_Click()
Dim MSOutlook As Object, Takvim As Object
    Set MSOutlook = CreateObject("Outlook.Application")
    Set Takvim = MSOutlook.CreateItem(1)
    With Takvim

        .Start = CDate(TextBox1.Text) + TimeValue(ComboBox1.Text) 'Başlama saati
        .End = .Start + TimeValue("00:00:00") 'Bitiş saati
        .Subject = "xx nolu problem"
        .Location = ""

[COLOR="Red"]        'Alt satır
        '.Body = "Gözükmesini istediğiniz metin-1" & Chr(13) & _
        "Gözükmesini istediğiniz metin-2" & Chr(13) & _

        
        'Font renk
        '.Body = "<font face=arial>Gözükmesini istediğiniz metin</font>"
               
        'Font renk + büyüklük + altsatır
        '.Body = "<p> <font size=2 color=red face=Tahoma>" & _
               "Gözükmesini istediğiniz metin-1" & "<br>" & _
                "Gözükmesini istediğiniz metin-2" & _
                "</font> </p>"[/COLOR]
        
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 120 'Anımsatıcı kaç dakika sonra haber vereyim
        .ReminderSet = True
        .Save
    End With
    Set Takvim = Nothing
    Set MSOutlook = Nothing
End Sub

 

[vivident]

Mail biçimi html mi? .htmlbody
Mail biçimi text mi? .body

sayın asri ;
htmlbody. olarak denedim, direk hata veriyor
body. olarak denediğimde hata vermiyor, lakin chr(13) bir alt satıra geçmek kodu dışında font, rengi, büyüklüğünü yapamıyorum.

 

[Asri]

Bu şekilde deneyin.
başka .body olmasın

Mail gönderiminde test

Private Sub CommandButton1_Click()
     Set OutApp = CreateObject("Outlook.Application")
      Set OutMail = OutApp.CreateItem(0)
      With OutMail
       .To = ""
       .CC = ""
       .Subject = ""
       .Display
     
        'Font renk + büyüklük + altsatır
        .HTMLBody = "<p> <font size=2 color=red face=Tahoma>" & _
               "Gözükmesini istediğiniz metin-1" & "<br>" & _
                "Gözükmesini istediğiniz metin-2" & _
                "</font> </p>"
                
       End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[vivident]

sayın asri ;

Sizin verdiğiniz kodlar "Yeni E-Posta" için
Ben Outlook takvimine randevu olarak atamak istiyorum. Randevu olarak da atanıyor, bu kısımda sorunum yok. Sorun sadece atanan randevunun içeriğini (font) değiştirememem

Rica etsem eklediğim videoyu izleyebilirmisiniz

 

[vivident]

konu günceldir

 

[Asri]

Burada takvim öğesi için .body de html desteklemediği yazıyor. Format olarak RFT kullanıyormuş.

https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/appointmentitem-body-property-outlook

Aynı sayfada mail için body bölümünde bodyformat seçeneğinde hmtl mevcut.

Bu durumda html ile çözüm bulamazsınız.

Bir şekilde body e yazacağınız şeyleri word editörde yazıp body aktarmak lazım. Body rft yi desteklediği için yazı formatları gelebilir.

 

[Asri]

A1 hücresine Deneme yazıp fontunu büyütün ve koyu yapın.
Kodu çalıştırın. Aynı formatta eklenecektir.

Buradaki mantık, hücreyi kopyala outlook editöre yapıştır.

Sub MakeApptWithRangeBody()
    
    Dim olApp As Outlook.Application
    Dim olApt As Outlook.AppointmentItem
    
    Const wdPASTERTF As Long = 1
    
    Set olApp = Outlook.Application
    Set olApt = olApp.CreateItem(olAppointmentItem)
    
    With olApt
        .Start = Now + 1
        .End = Now + 1.2
        .Subject = "Test Appointment"
        .Display
         Cells(1, 1).Copy
        .GetInspector.WordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF
    End With
End Sub

 

[vivident]

Sayın asri kod hata verdi.
Lakin açıklamalarınız için teşekkür ediyorum. Sanıyorum ki beni çok aşacak, bu şekilde kullanmaya devam edeceğim

 

[Asri]

Sayın asri kod hata verdi.
Lakin açıklamalarınız için teşekkür ediyorum. Sanıyorum ki beni çok aşacak, bu şekilde kullanmaya devam edeceğim

VBA tools reference den outlook ve word referanslarını ekleyin.

 

[vivident]

sayın asri konu çok eskide kaldı, hatırlamanız zor olabilir.
Lakin ben yeniden konu üzerinde sizden bilgi alma gereği duydum. 10 mesajınızda paylaştığınız kod ile outlook takvimde istediğim, font büyüklüğü, rengi, biçimini elde ettim. Peki hep hücreden mi aldırmak zorundayım biçimleri. Nedeni ise userform üzerindeki farklı textboxdaki bilgileri once hücreye aktarıp, daha sonrada hücrede biçimlenmiş verileri outlook takvimine göndermek zorunda kalacağım

9. mesajınızda bahsettğin RFT nedir ? Yani kısaca ben nasıl yaparım bu işi, hücre olayı işin içine girmeden

 

[vivident]

sayın asri sizin verdiğiniz kodda eklentiler yaptım ; userform textbox'da ki verileri once hücreye gönderiyorum, daha sonra hücreden alıp outlook takvime gönderiliyor. Outlook takvimde randevuya tıklayıp, içeriğini gördüğümüde istediğim format biçiminde oluşturulduğunu görüyorum.

Lakin randevuyu kapatırken "kayıt edilsin mi" diye soruyor. Kod içinde zaten "save" kodu yer alıyor. Neden bir kez daha kayıt edilsin mi diye soruyor

Private Sub CommandButton1_Click() 'hücreye gönder, hücreden al outlook'a gönder
Dim MSOutlook As Object, Takvim As Object
    Set MSOutlook = CreateObject("Outlook.Application")
    Set Takvim = MSOutlook.CreateItem(1)
    Const wdPASTERTF As Long = 1
    Sheets("AAA").Cells(20, 1).Value = TextBox2.Text
    With Takvim
        .Start = CDate(TextBox1.Text) + TimeValue(ComboBox1.Text) 'Başlama saati
        .End = .Start + TimeValue("00:00:00") 'Bitiş saati
        .Subject = "xx nolu problem"
         Cells(20, 1).Copy
        .GetInspector.WordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF
        .Location = ""
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 120 'Anımsatıcı kaç dakika sonra haber vereyim
        .ReminderSet = True
[COLOR="Red"]        .Save[/COLOR]
    End With
    Set Takvim = Nothing
    Set MSOutlook = Nothing
End Sub