Hirdetés

  2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)
  • Téma összefoglaló
    Utoljára frissítve: 2023-11-13 08:31

    PROHARDVER!

    A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
    Kérdés felvetése előtt olvasd el, ha még nem tetted.

Új hozzászólás Aktív témák

  • #46469 spe88 senior tag
    Új Válasz #46469
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    spe88

    senior tag

    Ismét kéne egy kis segítség. Van egy PDF-küldős makróm.

    Az alábbi pontokkal szembesülök.

    1. Az A1 cellában egy hiperhivatkozás van. A PDF-ben ez nem jelenik meg, csak mint szöveg látom.
    2. Az Outlook-üzenet első sora nem "Hallo Kollegen" ahogy megadtam, hanem "FalseHallo Kollegen"
    2. Az e-mail törzsben az első sor ( "FalseHallo Kollegen") az Times New Roman 12-es betűméret, míg a 2-3. sor 9-es betűméret Calibri.

    Megadtam milyen legyen a betűtípus a makróban és mégsem olyan. Illetve alapból Arial 10-es a betűtípus az e-mail-írásnál, szóval nem értem miért változtatja random Times New Romanra meg Calibrire.

    Köszönöm

    A makró:


    Sub SendPDF_WithAccountSignatiure()
     
      ' --> User settings, change to suit
      Const IsDisplay As Boolean = True  ' Change to False for .Send instead of .Display
      Const IsSilent As Boolean = False  ' Change to True to show Send status
      Const FontName = "Arial"           ' Font name of the email body
      Const FontSize = 11                ' Font size of the email body
      Const Account = 1                  ' Index or Name of the account to send from
      ' <-- End of the settings
     
      Dim IsCreated As Boolean
      Dim OutlApp As Object
      Dim char As Variant
      Dim PdfFile As String, HtmlFont As String, HtmlBody As String, HtmlSignature As String
     
      ' Edit the body's html text as required
      ' The tags are: h3 is for Header#3; b is for Bold; br is for line break
      HtmlBody = "Hallo Kollegen, <br>" _
               & "<br>" _
               & "Im Anhang sehen Sie die aktuelle PIP-Liste von BOS MOS."
     
      ' Set the font for the html-body (parentheses are just because of MrExcel posting limitation)
      HtmlFont = HtmlFont = "<body font: " & 11 & "pt " & Arial & ";color:black"">"
     
      ' Define PDF filename
      PdfFile = Range("'help_MOS'!an1")
     
      ' Replace illegal symbols in PdfFile by underscore
      For Each char In Split("? "" / \ < > * | :")
        PdfFile = Replace(PdfFile, char, "_")
      Next
     
      ' Apply %TEMP% path to the file name
      PdfFile = Environ("F:\03_PROJEKTE\02_BOS\2.4 SERIENBETREUUNG") & PdfFile & ".pdf"
       
      ' Try to delete PDF file if present
      If Len(Dir(PdfFile)) Then Kill PdfFile
     
      ' Export the specific worksheet as PDF
      With Worksheets("Report MOS")
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      End With
     
      ' Use the already open Outlook if possible
      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
     
      ' Prepare email with PDF attachment and the default signature
      With OutlApp.CreateItem(0)
     
        ' Set HTML format
        .BodyFormat = 2
        
        ' Add the attachment first for correct attachment's name with non English symbols
        .Attachments.Add PdfFile
     
        ' Set the required account by const Account
        Set .SendUsingAccount = OutlApp.Session.Accounts.Item(Account)
       
        ' Get default email signature without blinking (instead of .Display method)
        With .GetInspector: End With
        HtmlSignature = .HtmlBody
      
        ' Prepare e-mail
        .Subject = Range("'help_MOS'!an1")
        .To = Range("'help_MOS'!an2") ' <-- Put email of the recipient here
        .HtmlBody = HtmlFont & HtmlBody & HtmlSignature
              
        ' Try to send or just display the e-mail
        On Error Resume Next
        If IsDisplay Then .Display Else .Send
     
        ' Show error of the .Send method
        If Not IsDisplay Then
          ' Return focus to Excel's window
          Application.Visible = True
          ' Show error/success message
          If Err Then
            MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
            .Display
          Else
            If Not IsSilent Then
              MsgBox "E-mail successfully sent", vbInformation
            End If
          End If
        End If
        On Error GoTo 0
     
      End With
     
      ' Try to quit Outlook if it was not previously open
      If IsCreated Then OutlApp.Quit
     
      ' Try to release the memory of object variable
      Set OutlApp = Nothing
     
    End Sub

Új hozzászólás Aktív témák