VBA, чтобы сохранить файл XLTM как файл XLSB - PullRequest
Новая
       53

VBA, чтобы сохранить файл XLTM как файл XLSB

0 голосов
/ 15 февраля 2019

У меня есть скрипт, который открывает внешний файл для выполнения скрипта и после его завершения сохраняет как файл xlsb.Код отлично работал для сохранения из файла xlsb в файл xlsb.Но поскольку я хочу иметь некоторую безопасность для исходного файла, я хочу, чтобы исходный файл xlsb был файлом xltm.Я адаптировал к нему сценарий сохранения и протестировал его как отдельную процедуру в самом файле.Работает отлично.

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

Это код исходного файла : 

Option Explicit
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

Это относится к файлу external script , который нужно открыть и выполнить.

Файл external имеет этот скрипт (я только вставил сохранениекак часть сценария): 

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 workbookdirectory As String
Dim activewb As String

ActiveWorkbook.RefreshAll

activewb = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)

workbookdirectory = "M:\Commercie\Marktdata\IRi\Segment Ontwikkeling\"

workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:=workbookdirectory & activewb)

If workbook_Name = False Then

ActiveWorkbook.SaveAs filename:=activewb, FileFormat:=50

End If

Но когда я выполняю сценарий из оригинального файла , Excel зависает, как указано.Что нужно изменить, чтобы этот код работал с внешним файлом и сохранением из xltm в сценарий xlsb?

Как указывалось: единственное, что изменилось в сценарии в сценарии, - это сохранить как сценарий и изменение расширения xlsb на xltm - единственное, что изменилось в оригинальном файле .

...