VBA для создания папки из списка проверки данных и разрешения пользователю выбирать папку

Question

У меня три проблемы с моим кодом.

1. Когда пользователи выбирают папку для сохранения, она всегда сохраняется в папке выше. Например, если адрес - «Отдел \ Группа финансового анализа - Общие \ Рассылка», он всегда будет сохраняться в папке «Группа финансового анализа - Общие», даже если я выбрал папку «Рассылка».
2. Я получаю подсказки о сохранении каждый раз, когда он зацикливается. Мой макрос просматривает список проверки данных, создает папку (если ее нет) и сохраняет указанный PDF-файл в соответствующие папки. Пользователь может выбрать любую желаемую папку на выбранном мною Диске.
3. Если я не выберу папку (т. Е. Отменить), макрос запускается сам по себе и фактически создает папку и PDF .

Function selectfolder()
user_name = Environ("username")
Dim flder As FileDialog
Dim foldername As String
Set flder = Application.FileDialog(msoFileDialogFolderPicker) 'standard wording

'Prompt for folder creation
With flder
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Dept\"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode 'i.e. if OK is not pressed
foldername = .SelectedItems(1)

End With

NextCode:
GetFolder = foldername
Set flder = Nothing

End Function

Sub SaveActiveSheetAsPDF()

'Creating a message box to ask user
If MsgBox("This will print to PDFs. Continue?", vbYesNo + vbQuestion + vbDefaultButton2, "Printing to PDFs") = vbNo Then Exit Sub

Dim inputrange As Range
Dim cell As Range
Dim network, Address, Folder, Title As String

'Determine (set) where validation comes from - create a reference point
Set inputrange = Evaluate(Range("G2").Validation.Formula1)

For Each cell In inputrange

   Range("G2").Value = cell.Value

'Defining the Network Folder variables
network = Range("C6").Value
Address = selectfolder
Folder = Address & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"

'Creating the folder based on Network - No existing folder
If Dir(Folder, vbDirectory) = "" Then
'Create a folder
MkDir Folder
'Save Active Sheet as PDF and to Network file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Folder & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

'Creating Only the PDF based on Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Folder & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

End If

Next cell
    
'Create a message box at end of task to inform user it is complete
MsgBox "Generation of PDF Reports and Folders Completed", vbInformation, "Complete"


End Sub
 

Answer 1

1. Я предлагаю вам разбить код на разные части, чтобы увидеть, что это за переменные. (Чтобы добавить точку останова, щелкните в серой области слева, чтобы добавить красный кружок.)

   Папка = Адрес и сеть

Вероятно, ваша переменная «Адрес» не соответствует t заканчиваются на sla sh, поэтому я предполагаю, что вам понадобится что-то вроде: Address & "\" & network

Если вы прервете строку, которая создает PDF-файл, в окне отладки вы можете ввести

?Folder & "\" & Title & ".pdf"

, что, вероятно, покажет, почему ваши файлы не сохраняются в том месте, где вы хотите. Вы также можете создать переменную saveAs для хранения полного пути, что упростит просмотр значения.

Вы должны переместить код, чтобы запросить у пользователя каталог, вверх, за пределами вашего l oop. Я предполагаю, что вам нужно только один раз запросить каталог.

Если пользователь не выбирает папку, вы хотите выйти, но не есть код, чтобы справиться с этим. Что-то вроде ниже должно работать:

address = SelectFolder
If address = "" Then
    MsgBox "Canceled."
    Exit Sub
End If

Answer 2

Это правильный исправленный код :)

Option Explicit
Function selectfolder()

Dim user_name As String
user_name = Environ("username")

'Prompt for folder creation
With Application.FileDialog(msoFileDialogFolderPicker) 'standard wording
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Department\" 'base directory to open
.AllowMultiSelect = False
If .Show <> -1 Then Exit Function 'if user does not press OK, end the function'
selectfolder = .SelectedItems(1)

End With

End Function
Sub SaveActiveSheetAsPDF()

'Create a message box to ask user before proceeding
If MsgBox("This will print to PDFs. Continue?", vbYesNo + vbQuestion + vbDefaultButton2, "Printing to PDFs") = vbNo Then Exit Sub

'Defining the Type of Variables
Dim inputrange As Range
Dim cell As Range
Dim network, Address, Fldr, Title As String

'If user does not choose a folder
Address = selectfolder
If Address = "" Then
    Exit Sub
End If

'Determine (set) where validation comes from - create a reference point
Set inputrange = Evaluate(Range("G2").Validation.Formula1)

For Each cell In inputrange

   Range("G2").Value = cell.Value

'Defining the Company Network Folder variables
network = Range("C6").Value
Fldr = Address & "\" & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"

'Creating the folder based on Company Network - No existing folder
If Dir(Fldr, vbDirectory) = "" Then
'Create a folder
MkDir Fldr
'Save Active Sheet as PDF and to Company Network file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Fldr & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

'Creating Only the PDF based on Company Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Fldr & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

End If

Next cell
    
'Create a message box at end of task to inform user it is complete
MsgBox "Generation of PDF Reports and Folders Completed", vbInformation, "Complete"


End Sub