Excel to PDF - как указать, куда макрос будет сохранять файл PDF - PullRequest
Новая
       12

Excel to PDF - как указать, куда макрос будет сохранять файл PDF

0 голосов
/ 01 марта 2020

Я использую этот код, который в основном сохраняет последнюю строку моего листа Excel в файл PDF, он сохраняет файл PDF в папку, в которой находятся лист Excel и шаблон моего слова (они находятся в одной папке).

Как установить другое местоположение в качестве точки сохранения?
Я хочу ограничить пользователей указанным c местоположением, которое не является папкой, где находится лист Excel и слово Шаблон:

Например: Я хочу, чтобы файлы сохранялись здесь: "C: \ Users \ Пользователь \ Рабочий стол \ Папка"
Также, пожалуйста, направьте меня на как реализовать это в моем коде, вроде как новичок в этом. 

Sub RunMerge()
' Sourced from: https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html
' Note: this code requires a reference to the Word object model to be set, via Tools|References in the VBE.
Application.ScreenUpdating = False
Dim StrMMSrc As String, StrMMDoc As String, StrMMPath As String, StrName As String
Dim i As Long, j As Long
Const StrNoChr As String = """*./\:?|"
Dim wdApp As New Word.Application, wdDoc As Word.Document
wdApp.Visible = False
wdApp.DisplayAlerts = wdAlertsNone
StrMMSrc = ThisWorkbook.FullName
StrMMPath = ThisWorkbook.Path & "\"
StrMMDoc = StrMMPath & "MailMergeDocument.doc"
Set wdDoc = wdApp.Documents.Open(Filename:=StrMMDoc, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
With wdDoc
  With .MailMerge
    .MainDocumentType = wdFormLetters
    .OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
      LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
      "Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
      SQLStatement:="SELECT * FROM `Sheet1$`"
    i = .DataSource.RecordCount
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        StrName = .DataFields("Name")
      End With
      .Execute Pause:=False
      For j = 1 To Len(StrNoChr)
        StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
      Next
      StrName = Trim(StrName)
      With wdApp.ActiveDocument
        'Add the name to the footer
        '.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
        '.SaveAs Filename:=StrMMPath & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        ' and/or:
        .SaveAs Filename:=StrMMPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
        .Close SaveChanges:=False
      End With
    .MainDocumentType = wdNotAMergeDocument
  End With
  .Close SaveChanges:=False
End With
wdApp.DisplayAlerts = wdAlertsAll
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
Application.ScreenUpdating = False
End Sub

Ответы [ 3 ]

0 голосов
/ 02 марта 2020

Ваш код использует переменную strMMPath в качестве пути здесь. 

.SaveAs Filename:=StrMMPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False

Чтобы изменить его на папку на рабочем столе текущего пользователя, используйте это 

Dim SavePath as String

SavePath = "C:\Users\" & Environ$("UserName") & "\Desktop\Folder\"
.SaveAs Filename:=SavePath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False

Примечание: Environ$("UserName") возвращает имя пользователя, вошедшего в систему в данный момент

0 голосов
/ 02 марта 2020

Поэтому измените: 

StrMMPath = ThisWorkbook.Path & "\"

, чтобы указать, куда вы хотите сохранить файл. Например: 

StrMMPath = C:\Users\" & Environ("Username") & "\Desktop\Folder\"

Было бы приятно увидеть, что вы действительно вкладываете в это все усилия. Сайт, откуда вы взяли код, даже говорит вам, как сделать такое изменение !!! Похоже, что до сих пор все, что вы делали в нескольких потоках, просят кормить ложкой с помощью решений и / или модификаций кода, который вы скопировали с другого сайта.

PS: Это также обычная любезность голосуйте за ответы, которые помогли вам.

0 голосов
/ 02 марта 2020

Я думаю, это то, что вы ищете: 

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF FileName:="sales.pdf" Quality:=xlQualityStandard OpenAfterPublish:=True

https://docs.microsoft.com/en-us/office/vba/api/excel.workbook.exportasfixedformat

...