Сохраните не сформулированную версию электронной таблицы VBA - PullRequest
Новая
       30

Сохраните не сформулированную версию электронной таблицы VBA

0 голосов
/ 01 ноября 2019

Приведенный ниже VBA прекрасно работает при поддержке другого пользователя. Проблема, с которой я столкнулся, и, надеюсь, последняя, ​​заключается в том, что при обновлении исходной электронной таблицы, которая собирает данные из других источников, обновленная электронная таблица также обновляется. Не идеально подходит для отслеживания заказов на покупку и т. Д. Заранее спасибо. 

Option Explicit

Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal lpPath As String) As Long

Sub Check_CreateFolders_YEAR_SO_WODRAFT()

    Dim wb As Workbook
    Dim Path1 As String
    Dim Path2 As String
    Dim Path3 As String
    Dim Path4 As String
    Dim myfilename As String
    Dim fpathname As String

    Set wb = Workbooks.Add
    ThisWorkbook.Sheets("Jobs Sheet").Copy Before:=wb.Sheets(1)
    Path1 = "C:\Users\jackson.wills\Sparter Ltd\Engineer Order - e-Board"
    Path2 = Range("A23")
    Path3 = Range("I3")
    Path4 = Range("I4")
    myfilename = Range("I3").Value & Range("A1").Value & Range("I4").Value & Range("A1").Value & Range("AA1").Value
    fpathname = Path1 & "\" & Path2 & "\" & Path3 & "\" & Path4 & "\" & myfilename & ".xlsx"

    If Dir("C:\Users\jackson.wills\Sparter Ltd\Engineer Order - e-Board\" & Path2 & "\" & Path3 & "\" & Path4, vbDirectory) = "" Then
        MakeSureDirectoryPathExists "C:\Users\jackson.wills\Sparter Ltd\Engineer Order - e-Board\" & Path2 & "\" & Path3 & "\" & Path4 & "\"
        ' MkDir Path:="C:\Users\jackson.wills\Sparter Ltd\Engineer Order - e-Board\" & Path2
        ' MkDir Path:="C:\Users\jackson.wills\Sparter Ltd\Engineer Order - e-Board\" & Path2 & "\" & Path3
        ' MkDir Path:="C:\Users\jackson.wills\Sparter Ltd\Engineer Order - e-Board\" & Path2 & "\" & Path3 & "\" & Path4
        MsgBox "Completed"
    Else
        MsgBox "Sales Order Folder Already Exists so we'll save it in there"
    End If

    MsgBox "You are trying to save the file to:" & vbCrLf & fpathname
    wb.SaveAs Filename:=fpathname & ".xlsx"

End Sub

1 Ответ

1 голос
/ 01 ноября 2019

Если я понимаю ваш вопрос, просто сделайте что-то вроде этого:

После строки 

ThisWorkbook.Sheets("Jobs Sheet").Copy Before:=wb.Sheets(1)

добавьте эти строки: 

With wb.Sheets("Jobs Sheet")
    .UsedRange.Value = .UsedRange.Value
End With
...