Я пытаюсь упростить сценарий file_split до уровня самообслуживания в моем отделе. Никто на самом деле не понимает язык, поэтому я проверял, можно ли еще что-нибудь упростить, чтобы коллегам не приходилось обновлять код из панели редактора.
например, у меня есть такие вещи, как Basepath, чтобы указать, где файлы будут сохранены. Как я могу изменить
Dim Basepath As String
Basepath = "C:\Users\File Cuts\"
directory as string
на что-то вроде этого, где пользователь может выбрать путь к папке?
Dim Basepath as filedialog
with basepath
.title = "Select save location"
.directory = .selecteditems(1)
end with
, а затем случаи, когда у меня есть определенные c столбцы для ссылки (цель столбцы значений для каждого нового файла, столбцы соглашения об именах и т. д. c ...)
как в:
Dim Manager_Name, Login_ID, Leader
Manager_Name = SourceData(i,4)
Login_ID = SourceData(i,5)
Leader = SourceData(i,9)
для ввода в поле ввода для буквы столбца, например:
Dim column_selection as variant
column_selection = InputBox("Enter Column Letter")
Manager_Name = SourceData(i,column_selection)
Есть довольно много ссылок, которые я хотел бы посмотреть, смогу ли я изменить их так, чтобы можно было вносить изменения, не касаясь кода (столбец располагается там, где варианты, такие как имя и идентификатор входа будут много меняется)
остаток кода:
Option Explicit
Sub File_Splits()
Dim Wb As Workbook
Dim SourceData, Mgr_Name, Login_Id
Dim i As Long, j As Long, k As Long, a As Long
Dim Destination_Cell As Range
Dim Basepath As String, strNewpath As String, strLeader As String
Basepath = "C:\File Cuts\" '1. paste in file save pathway, keep last \
Set Wb = Workbooks.Open("C:\File_Split_Mgr_Template.xlsx") '2. paste template ws address here
Set Destination_Cell = Wb.Worksheets("Manager Data").Range("A2") '3. Update worksheet name and target cell
With ThisWorkbook.Worksheets("Roster")
SourceData = .Range("I10", .Range("A" & Rows.Count).End(xlUp)) '4. change I10 to your last column letter, dont change the number(keep the 10)
End With
Wb.Activate
Call Speed_Up_Code(True)
For i = 1 To UBound(SourceData)
If SourceData(i, 5) <> Login_Id Then '5. change the 1 to login column #
If i > 9 Then
Destination_Cell.Select
strNewpath = Basepath & strLeader & "\" 'comment this out if folders aren't needed
If Len(Dir(strNewpathD, vbDirectory)) = 0 Then 'comment this out if folders aren't needed
MkDir strNewpath 'comment this out if folders aren't needed
End If 'comment this out if folders aren't needed
Wb.SaveCopyAs strNewpath & _
ValidFileName(Login_Id & "_" & Mgr_Name & "_File Name.xlsx") '6. update file name
End If
With Wb.Worksheets("Manager Data") '7. change to template sheet
.Rows(2 & ":" & .Rows.Count).ClearContents '8. change 2 to row after header(s)--if header isn't in row 1
End With
Mgr_Name = SourceData(i, 4) '9. change 1 to mgr name column
Login_Id = SourceData(i, 5) '10. change 2 to login ID column
strLeader = SourceData(i, 9) '11. change 5 to lvl 3 mgr column
j = 0
End If
a = 0
For k = 1 To UBound(SourceData, 2)
Destination_Cell.Offset(j, a) = SourceData(i, k)
a = a + 1
Next
j = j + 1
Next
If Len(Dir(strNewpath, vbDirectory)) = 0 Then
MkDir strNewpath
End If
SaveCopy Wb, strNewpath, Login_Id, Mgr_Name
Call Speed_Up_Code(False)
End Sub
Public Sub SaveCopy(Wb As Workbook, strNewpath As String, Login_Id, Mgr_Name)
Wb.SaveCopyAs strNewpath & _
ValidFileName(Login_Id & "_" & Mgr_Name & "_File Name.xlsx") '12. update file name
End Sub