VBA сохранить файл Excel с указанным именем в определенном месте - PullRequest
Новая
       23

VBA сохранить файл Excel с указанным именем в определенном месте

0 голосов
/ 26 ноября 2018

Недавно я спросил о сохранении файла Excel с определенным именем в заданном месте: Получение правильного имени сохранения по умолчанию и сохранение каталога с пробелами в VBA

Я хочу использовать это жепроцедура, но несколько другим способом.Я попытался отредактировать код, чтобы он работал, но у меня при запуске кода появляется черный экран с именем файла.

Файл, который я хочу сохранить с помощью подпрограммы, представляет собой шаблон, который обновляется с помощью новогоданные каждые 4 недели.Это файл только для чтения, который работает как исходный шаблон, и после обновления данных я должен быть сохранен в другом месте, чтобы сохранить исходный исходный файл от ошибок / нежелательных изменений.

При обновлении,шаблон открывает файл, содержащий скрипт обновления с именем «refresh_segment_template.xlsm».

код в шаблоне : 

Option Explicit

Dim aantalrijen As Long

Const SheetSchaduwblad As String = "schaduwblad"
-------
Sub vernieuwalles()
Dim myTemplate As String: myTemplate = ActiveWorkbook.Name
Dim myTool As String: myTool = "refresh_segment_template.xlsm"

  Application.ScreenUpdating = False

  Workbooks.Open GetPath & myTool
  Application.Run myTool & "!vernieuwalles", myTemplate

  Call Windows(myTool).Close(False)

  Application.ScreenUpdating = True

End Sub
Private Function GetPath() As String
Dim myPosition As Integer
Dim myPath As String: myPath = ActiveWorkbook.Path

  myPosition = InStr(StrReverse(myPath), "\") - 1
  myPosition = Len(myPath) - myPosition

  GetPath = Mid(myPath, 1, myPosition - 1) & "\XLAM\"

End Function

код в refresh_segment_template : 

Option Explicit

Dim aantalrijen As Long

Const SheetSchaduwblad As String = "schaduwblad"
------------------    
Sub vernieuwalles(mytemplate As String)

  Windows(mytemplate).Activate

  On Error GoTo Err_

  Application.StatusBar = "Bezig met vernieuwen"

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

'  Call SheetOpschonen

  Call datawissen
  Call dataplaatsen
  Call kolomtitels
  Call toevoegen
  Call maaktabel
  Call refreshpivots

Exit_:
  Application.StatusBar = ""
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Exit Sub

Err_:
  Call MsgBox(Err.Number & vbCrLf & Err.Description)
  Resume Exit_

Application.Calculation = xlCalculationAutomatic

End Sub
    -------------
    Sub refreshpivots()
    Dim workbook_Name As Variant
    Dim location As String
    Dim filename As String

    filename = "M:\Commercie\Marktdata\IRi\Segment Ontwikkeling\" & ActiveWorkbook.Name

      ActiveWorkbook.RefreshAll

    workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:="M:\Commercie\Marktdata\IRi\Segment Ontwikkeling\")

    If workbook_Name <> False Then

        ActiveWorkbook.SaveAs filename:=filename, WriteResPassword:="TM", FileFormat:=50

    End If

    End Sub

Теперь мне интересно, как я могу заставить последний скрипт использовать имя файла шаблона и сохранить его в заданном месте скрипта (например, M: \ Commercie \ Marktdata \ IRi \ Segment Ontwikkeling).

Когда я выполняю приведенный выше код, я получаю экран «Сохранить как», но без указания имени файла, только заданный каталог является правильным.

refresh_segment_template является .xlsm файл.Шаблон представляет собой файл .xlsb .

...