By yy1004 w środę, 09 czerwca 2021 r
Opublikowany w przewyższać
Odpowiedzi 0
Lubi 0
odwiedzajacy 2.7 tysięcy
Głosów 0
Mam makro działające w celu zapisania wybranej karty jako pliku PDF w wybranej ścieżce pliku i wiadomości e-mail do listy osób w określonej komórce, ale nie mogę poprawnie działać, aby nazwa tego zapisanego i załączonego pliku PDF była wartość komórki w arkuszu. Byłbym wdzięczny za wszelką pomoc. Próbowałem różnych rzeczy, które znalazłem na tych forach, ale ciągle wyświetla mi się błąd, więc wrócę do mojego zapisanego kodu. Poniżej znajduje się miejsce, w którym się znajduję: Sub Saveaspdfandsend2()Dim xSht As WorksheetDim xFileDlg As FileDialogDim xFolder As StringDim xYesorNo As IntegerDim xOutlookObj As ObjectDim xEmailObj As ObjectDim xUsedRng, xRgInser As RangeDim xB As BooleanSet xSht = ActiveSheetxPath = "C:\Users\XXX " xFolder = xPath + "\" + xSht.Name + ".pdf" If Len(Dir(xFolder)) > 0 ThenxYesorNo = MsgBox(xFolder & "już istnieje." & vbCrLf & vbCrLf & "Czy chcesz go zastąpić? ", _vbYesNo + vbQuestion, "Plik istnieje") Przy błędzie Wznów NextIf xYesorNo = vbYes ThenKill xFolderElseMsgBox "Jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wyjście z makra"Wyjście z SubEnd IfIf Err.Number <> 0 ThenMsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem. " _& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"Wyjście z SubEnd IfEnd If Set xUsedRng = xSht.UsedRangeIf Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then'Save as Plik PDFxSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard 'Create Outlook emailSet xOutlookObj = CreateObject("Outlook.Application")Set xEmailObj = xOutlookObj.CreateItem(0)With xEmailObj.Display.To = Range( "S7").CC = Range("S8").BCC = Range("S5").Subject = Range("S6") + "-" + xStr + ".pdf".Attachments.Add xFolderIf DisplayEmail = False Then'.SendEnd IfEnd WithElseMsgBox „Aktywny arkusz roboczy nie może być pusty” Exit SubEnd IfEnd Sub
Wyświetl pełny post