Mesaja font ve biçim ekleme

[Mehmet Sait]

Merhaba

Ekli kodda bulunan Mesaj = Range (" N5 ") koduna yazı font ve biçim eklemek istiyorum. Arial 12 Bold yapmak için ne yapmam gerek.

Yardımlarınız için teşekkür ederim.

Dim Boolean Olarak İşlendi Dim I Uzun Dize Olarak Dize PdfFile, Dize Başlığı Nesne Olarak Dışa Çıkmak Başlık = Range ("E2") ve "-" ve Aralık ("E3") Kime = Range ("N2") Bilgi = Range ("N3") Gizli = Range ("N4") Mesaj = Range ("N5") 'PdfFile = ActiveWorkbook.FullName 'i = InStrRev (PdfFile, ".") Eğer i> 1 ise PdfFile = Sol (PdfFile, i - 1) PdfFile = PdfFile & "" & [E2] & "" & [E3] & ".pdf" ActiveSheet ile .ExportAsFixedFormat Türü: = xlTypePDF, Dosya Adı: = PdfFile, Kalite: = xlQualityStandard, IncludeDocProperties: = Doğru, IgnorePrintAreas: = False, OpenAfterPublish: = False İle bitmek Hata Devam Ediyor Sonraki OutlApp = GetObject ("Outlook.Application") öğesini ayarla Err ise OutlApp = CreateObject öğesini ayarla ("Outlook.Application") IsCreated = Doğru Son OutlApp.Visible = Doğru Hatada GoTo 0 OutlApp.CreateItem ile (0) .Subject = Başlık .To = Kime .CC = Bilgi 'bilgi olarak kime .BCC = Gizli .Body = Mesaj '"....," & vbLf & vbLf _ '& "....." & vbLf & vbLf _ '& "...." & vbLf _ '& [C81] & vbLf _ '& [C83] & vbLf & vbLf .Attachments.PdFdfFile Ekle [/ iCode]

 

[mancubus]

MailItem nesnesinin (object) "Body" yerine "HTMLBody" özelliğini (property) kullanarak olur.

Renk değişikliği de yapabilirsiniz. mesela ben color=""Blue"" ibaresi ile yazı rengini mavi (Blue) yaptım

    Mesaj = "<b><font size=""3"" face=""Arial"" color=""Blue"">" & Range("N5").Value & "</font></b>"

    With CreateObject("Outlook.Application")
        With .CreateItem(olMailItem)
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = ""
            .HTMLBody = Mesaj
            '.Save
            .Display
            '.Send
        End With
    End With

eklenebilir.

 

[Mehmet Sait]

Sayın mancubus,

Öncelikle desteğiniz için teşekkür ederim. Verdiğiniz şekilde revize ettim ancak E-Mail gönderilemedi hatası vermekte.

Kullandığım kod:

Private Sub CommandButton1_Click()

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  If [E2] = "" Then
MsgBox "Lütfen Tarih Giriniz..!", vbInformation, "MSC"
Range("E2").Select
GoTo 10
Else
 
 
  Title = Range("E2") & " - " & Range("E3")
  Kime = Range("O2")
  Bilgi = Range("O3")
  Gizli = Range("O4")
  Mesaj = Range("O5")
                    
'  PdfFile = ActiveWorkbook.FullName
'  i = InStrRev(PdfFile, ".")
'  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "" & [E2] & "  " & [E3] & ".pdf"

  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

With OutlApp.CreateItem(0)
  
    .Subject = Title
    .To = Kime
    .CC = Bilgi ' bilgi olarak kime
    .BCC = Gizli
    .Body = Mesaj
    '"....," & vbLf & vbLf _
     '     & " ....." & vbLf & vbLf _
      '    & "...." & vbLf _
       '   & [C81] & vbLf _
        '  & [C83] & vbLf & vbLf
    .Attachments.Add PdfFile
  
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail gonderilemedi", vbExclamation, "MSC"
    Else
      MsgBox " E-mail gonderildi... İşleminiz tamamlanmıştır..! ", vbInformation, "MSC"
    End If
    On Error GoTo 0
  
  End With

  Kill PdfFile

  If IsCreated Then OutlApp.Quit

  Set OutlApp = Nothing

Call VeriyeGoreKopya

End If
10:
End Sub

 

[mancubus]

Verdiğiniz şekilde revize ettim

buna itiraz ederim işte.

bir daha kontrol edin.

 

[Mehmet Sait]

Merhaba,

Kodları revize ettim. Gönder butonuna basınca bu ekran çıkıyor. " Mesaj = Range("O5") " kısmında bulunan mesajı biçimlendirmek istiyorum.

 

[mancubus]

kesinlikle dediğimi yapmamışsınız.

 

[mancubus]

Private Sub CommandButton1_Click()

    Dim PdfFile As String, Title As String

    If Range("E2").Value = "" Then
        MsgBox "Lütfen Tarih Giriniz..!", vbInformation, "MSC"
        Range("E2").Select
        Exit Sub
    End If

    PdfFile = PdfFile & "" & Range("E2").Value & "  " & Range("E3").Value & ".pdf"
    
    On Error Resume Next
    
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
    
    With CreateObject("Outlook.Application")
        With .CreateItem(olMailItem)
            .To = Range("O2").Value
            .CC = Range("O3").Value
            .BCC = Range("O4").Value
            .Subject = Range("E2") & " - " & Range("E3")
            .HTMLBody = "<b><font size=""3"" face=""Arial"" color=""Blue"">" & Range("O5").Value & "</font></b>"
            .Attachments.Add PdfFile
            '.Save
            '.Display
            .Send
        End With
    End With
    
    If Err Then
        MsgBox "E-mail gonderilemedi", vbExclamation, "MSC"
    Else
        MsgBox " E-mail gonderildi... İşleminiz tamamlanmıştır..! ", vbInformation, "MSC"
    End If
    
    Kill PdfFile
    
    Call VeriyeGoreKopya
    
End Sub

 

[mancubus]

umarım revize etmediğinizi benim mesajdan görmüşsünüzdür.

sizin kodun tamamının yerine yazdım.


1
tamamının ne işe yaradığını kendi başınıza anlamadığınız kodları kullanmayın.

2
bir defa kullanılıp iş sona erecek değerler için yüzlerce değişken tanımlamaya, onlara değer veya nesne atamaya, sonra bunları bir takım nesnelerin özelliği vs için kullanmaya gerek yok.

Dim Bilgi

Bilgi = Range("A5").Value

.CC = Bilgi

değil

.CC = Range("A5").Value

bu kadar

3
Kullanılabildiği yerler ile sınırlı olmak üzere ya hep [A1] deyin ya da hep Range("A1")

 

[Mehmet Sait]

Sayın mancubus,

Kesinlikle haklısınız hocam, şu an çok güzel çalışıyor. Yardımlarınız için teşekkür ederim.