Opened Workbooks are still opened after executing Macro (Workbook.Close doesn't work)

[o0omax]

Hello,


i wrote a code which should automatically generate an Excel & PowerPoint File for each company we are working with. The CompanyNumber and CompanyName are in an array and the data which alters the about to be copied diagram is in ThisWorkbook.


The code is running fine, although I did not manage to close the opened Workbooks (wb). After executing the Sub CreateMultipleDocs() the Workbooks wb (are still running). I tried tried to narrow the mistake down and it seem to not be able to close the Workbook wb (or wbTemp respecticely) when the macro comes to the Sub CopyPaste and reaches the line where the diagram gets pasted in the PowerPoint. -> marked it in red


I divided the project in MainSubs, so Sub which I need not only for the automation, but also for seperate use (through a button), and in SupportingSubs, which are there to support (Functions & Subs).


I used .UsedContents.Clear and Visible = xlSheetVeryHidden because when I deleted the sheet a microsoft macro security message appeared which collapses the automation.


MainsSubs:

Option Explicit

Sub CreateMultipleDocs()
Call InitProgressBar
Application.Visible = True
SpeedUp True
'Datum und Zeit
Dim t0 As Double
Dim Datum As String
t0 = CDbl(Now())
Datum = Format(Date, "yyyy/mm/dd")
Datum = Replace(Datum, ".", "")
'Deklaration für die k-Schleife
Dim CompanyNumber As String
Dim Multiple As Boolean
'Excel
Dim wbSrc As Workbook
Dim wb As Workbook
Dim SrcPath As String
Set wbSrc = ThisWorkbook
SrcPath = wbSrc.Path
'Powerpoint
Dim PP As Object
Set PP = CreateObject("PowerPoint.Application")
Dim PPsrc As Presentation
Dim PPpres As Presentation
Dim CompanyName As String
Set PPsrc = PowerpointFile(PP, SrcPath)
'Array
Dim myAr As Variant
Dim lenArWith0 As String
Dim NumberBanks As Integer
NumberBanks = 0
myAr = wbSrc.Sheets("Automation Tool").ListObjects("Dateneingabe").DataBodyRange.Value
lenArWith0 = UBound(myAr, 1) - LBound(myAr, 1) + 1
'Anzahl der tatsächlichen Anzahl an Banken (Leezeilen rausgenommen)
Dim i As Integer
For i = 1 To lenArWith0
    If myAr(i, 1) = Empty Then
    Else
    NumberBanks = NumberBanks + 1
    End If
Next
Dim DelRoh As Boolean
    If wbSrc.Sheets("Automation Tool").Range("DelRoh") = "Ja" Then
        DelRoh = True
    End If
''''''''''Loop''''''''''''''''''''''
Dim k As Integer
For k = 1 To lenArWith0
'CompanyNumber
CompanyNumber = myAr(k, 1)
CompanyName = myAr(k, 2)
'wenn ein andere Anzeigename gewünscht wurde -> überschreiben
If myAr(k, 3) = Empty Then
   Else
   CompanyName = myAr(k, 3)
End If
'Order erstellen
Dim folderName As String
folderName = SrcPath & "\" & Datum & "_" & CompanyName & "-" & CompanyNumber
MkDir (folderName)
'Excel CopyAs
Dim DateiName As String
DateiName = Datum & "_" & CompanyName & "-" & CompanyNumber
Set wbSrc = ThisWorkbook
wbSrc.SaveCopyAs (folderName & "\" & DateiName & ".xlsm")
Application.DisplayAlerts = False
'Application.ScreenUpdating = False
'Application.Visible = False
Set wb = Workbooks.Open(folderName & "\" & DateiName & ".xlsm")
Application.DisplayAlerts = True
'Application.ScreenUpdating = False
'Application.Visible = False
'PowerPoint CopyAs
'get powerPoint
PPsrc.SaveCopyAs (folderName & "\" & DateiName & ".pptx")
Set PPpres = PP.Presentations.Open(folderName & "\" & DateiName & ".pptx", WithWindow:=msoFalse)
'Datenanforderung
wb.Sheets("Preparing Data").Range("H3") = myAr(k, 1) 'Sheets("Preparing Data")
wb.Sheets("Preparing Data").Range("M3") = 0
Calculate
Call CopyPaste(wb, PPpres, CompanyName, CompanyNumber)
If DelRoh Then
   Call DelRohdaten(wb)
End If
'Fusionpapier ausblenden (False = ausblenden)
Call Fusion(wb, False)
'Close Workbook
wb.Save
wb.Close False
PPpres.Save
PPpres.Close
'Progress Bar
Dim currentProgress As Double
Dim BarWidth As Long
currentProgress = k / NumberBanks
BarWidth = Progress.Border.Width * currentProgress
With Progress
     .Bar.Width = BarWidth
     .Text.Caption = k & " von " & NumberBanks & " Nutzenrechner (pptx & xlsm) wurden erstellt."
     .CurrentBank.Caption = CompanyName & " wurde erstellt!"
End With
DoEvents 'sicherstellen, dass Events immer noch ausgeführt werden können
Next
'Loop
'Nachricht, dass es funktioniert hat
Unload Progress
With Progress
     .Text.Caption = k - 1 & " von " & NumberBanks & " Nutzenrechner (pptx & xlsm) wurden erstellt."
     .CurrentBank.Caption = "Die Dateien wurden erstellt und befinden sich in dem  Ordner, dieser Excel Datei. Bitte schließen Sie dieses Fenster!" & vbCrLf & vbCrLf & "Benötigte Zeit: " & Format(Now - t0, "hh:mm:ss")
     .Show
End With
DoEvents 'sicherstellen, dass Events immer noch ausgeführt werden können
'MsgBox "Es wurden " & k - 1 & " Ordner mit jeweils einer Excel Datei und einer PowerPoint Datei erstellt!" & vbCrLf & vbCrLf & "Diese befinden sich in dem gleichen Ordner, wo die Excel lag, von der dieses Makro ausgeführt wurde." & vbCrLf & vbCrLf & "Benötigte Zeit: " _
 & Format(Now - t0, "hh:mm:ss"), vbInformation, "Auswertung abgeschlossen" '& Chr(13) & PP.Quit
'Progress Bar ausschalten
Unload Progress
SpeedUp False
Application.Visible = True
End Sub

Sub UpdateMyDiagram()
Dim PP As Object
Dim PPpres As Presentation
Set PP = CreateObject("PowerPoint.Application")
Dim wb As Workbook
Dim CompanyNumber As String
Set wb = ThisWorkbook        
Set PPpres = PowerpointFile(PP, ThisWorkbook.Path)
Call CopyPaste(wb, PPpres)
MsgBox "Die MyDiagram wurde aktualisiert"
End Sub

Sub DelRohdatenOfThisWB()
Call DelRohdaten(ThisWorkbook)
End Sub

Sub FusionYes(Optional wb As Workbook)
If wb Is Nothing Then
   Set wb = ThisWorkbook
End If
With wb
   .Sheets("Fusion").Visible = True
   .Sheets("Zins").Visible = True
   .Sheets("Preparing Data").Columns("L:L").EntireColumn.Hidden = False
   .Sheets("Preparing Data").Columns("N:N").EntireColumn.Hidden = False
End With
End Sub

Sub FusionNo(Optional wb As Workbook)
If wb Is Nothing Then
    Set wb = ThisWorkbook
End If
With wb
   .Sheets("Fusion").Visible = False
   .Sheets("Zins").Visible = False
   .Sheets("Preparing Data").Columns("L:L").EntireColumn.Hidden = True
   .Sheets("Preparing Data").Columns("N:N").EntireColumn.Hidden = True
End With
If unlocked Then
    wb.Sheets("MyDiagram").Activate
End If
End Sub

HelpingSubs:

Public Sub Fusion(wbTemp As Workbook, IsFusion As Boolean)
If IsFusion Then
    Call FusionYes(wbTemp)
Else
    Call FusionNo(wbTemp)
End If
End Sub

Public Sub CopyPaste(wbTemp As Workbook, PPpresTemp As Presentation, Optional CompanyNameTemp As String, Optional CompanyNumberTemp As String)
'Declare variables
Dim ppSlide As Slide
Dim myShape As Object
Dim objCh As Object
Dim MyChartName As String
'SLIDE 1
'Delete charts
Set ppSlide = PPpresTemp.Slides(1)
MyChartName = "MyDiagram"
For Each objCh In ppSlide.Shapes 
     If objCh.Name = MyChartName Then
         objCh.Delete
     End If
Next
'copy from Excel
Application.CutCopyMode = False
wbTemp.Sheets("MyDiagram").ChartObjects("MyDiagram").Copy
'paste to PPT
Set myShape = PPpresTemp.Slides(1).Shapes.Paste 'Special(DataType:=ppPasteDefault) '11 = ppPasteShape 2 = ppPasteEnhancedMetafile
Application.CutCopyMode = False
With myShape
     .Left = 3
     .Top = 130
     .Width = 932
End With
If CompanyNameTemp = "" Then
     CompanyNameTemp = wbTemp.Sheets("Preparing Data").Range("H4").Text
End If
If CompanyNumberTemp = "" Then
     CompanyNumberTemp = wbTemp.Sheets("Preparing Data").Range("H3").Text
End If
PPpresTemp.Slides(1).Shapes("Name").TextFrame.TextRange.Text = CompanyNameTemp & " (CompanyNumber: " & CompanyNumberTemp & ") - " & Sheets("MyDiagram").Range("X8").Text
'SLIDE 2
'Delete charts
Set ppSlide = PPpresTemp.Slides(2)
MyChartName = "My2ndDiagram"
For Each objCh In ppSlide.Shapes '(ppSlide.Shapes.Count)
     If objCh.Name = MyChartName Then
         objCh.Delete
     End If
Next
'copy from Excel
Application.CutCopyMode = False
wbTemp.Sheets("My2ndDiagram").ChartObjects("My2ndDiagram").Copy
'paste to PPT
Set myShape = PPpresTemp.Slides(2).Shapes.PasteSpecial(DataType:=ppPasteDefault)
Application.CutCopyMode = False
With myShape
    .Left = 26
    .Top = 175
 End With
End Sub

Public Sub DelRohdaten(wbTemp As Workbook)
'hardcode formulas
wbTemp.Sheets("Preparing Data").Range("H3:H53") = wbTemp.Sheets("Preparing Data").Range("H3:H53").Value 
wbTemp.Sheets("Preparing Data").Range("M3:M53") = wbTemp.Sheets("Preparing Data").Range("M3:M53").Value 
'löschen der Sheets
wbTemp.Sheets("data2").UsedRange.Clear
wbTemp.Sheets("data2").Visible = xlSheetVeryHidden
wbTemp.Sheets("data").UsedRange.Clear
wbTemp.Sheets("data").Visible = xlSheetVeryHidden
wbTemp.Sheets("MyDiagram").Activate
wbTemp.Sheets("Automation Tool").Visible = xlSheetVeryHidden
wbTemp.Sheets("Preparing Data").Visible = xlSheetVeryHidden
wbTemp.Sheets("MyDiagram").Activate
End Sub

Public Sub InitProgressBar()
With Progress 
   .Bar.Width = 0
   .CurrentBank = "Die Dokumente befinden sich nach Ausführung des Makros in dem Dateipfad der Exceldatei."
   .Text.Caption = "0 Nutzenrechner (pptx & xlsm) wurden erstellt"
   .Show vbModeless 
End With
End Sub

Public Sub SpeedUp(SpeedUpOn As Boolean)
With Application
    If SpeedUpOn Then
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayStatusBar = False 'in case you are not showing any messages
    Else
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayStatusBar = True
   End If
End With
End Sub

Public Function PowerpointFile(PPtemp As Object, SrcPath As String) As Presentation
Dim ppFileName, pptpath As String
Dim PPpresTemp As Presentation
pptFileName = Dir(SrcPath & Application.PathSeparator & "*.pptx")
pptpath = SrcPath & Application.PathSeparator & pptFileName
Set PPpresTemp = GetPowerpointFileIfOpen(PPtemp, pptpath)
If PPpresTemp Is Nothing Then
   Set PPpresTemp = PPtemp.Presentations.Open(pptpath, WithWindow:=msoFalse)
End If
Set PowerpointFile = PPpresTemp
End Function

Public Function GetPowerpointFileIfOpen(PPtemp As Object, pptpath As String) As Object
For Each p In PPtemp.Presentations
     If p.FullName = pptpath Then
         Set GetPowerpointFileIfOpen = p
         Exit Function
      End If
Next p
End Function

[rollis13]

I wasn't able to debug your macros but I believe that since in macro CreateMultipleDocs you start using variable ws as:

Set wb = Workbooks.Open(folderName & "\" & DateiName & ".xlsm")

then on the way in macro Fusion, which calls macro FusionYes and FusionNo, and in these you set once again variable wb as:

Set wb = ThisWorkbook

so when you get back to to first macro which is supposed to use:

wb.Save
wb.Close False

you will have reference to the wrong file. Try using a different variable name instead of wb in the Fusionxxx macros.

[o0omax]

I changed it in the code but it is still not working.

Set wb = ThisWorkbook

will only be declared if I execute FusionNo (or FusionYes) directly from This workbook. So the Sub Fusion has to work when CreateMultipleDocs is executed (wb is passed to the sub) and has to work seperatly when pressing a button.

When I comment out this line, the workbooks will get closed properly.

Call CopyPaste(wb, PPpres, CompanyName, CompanyNumber)

In CopyPaste the previously opened wb gets passed to this sub and a diagram will be copied from Excel to Powerpoint. I tried to close the passed workbook (wbTemp) in the CopyPaste Sub right after calling CopyPaste (to locate the error) and it closed properly. Until i move wbTemp.close after this line of code:

Set myShape = PPpresTemp.Slides(1).Shapes.Paste

[rollis13]

Since I'm unable to debug your macros can't be of any other help. You can do it by yourself, add a Stop and run your macro, when debug appears check if the variable ws refers to the workbook opened by Set ws = Workbooks.Open(folderName & "" & DateiName & ".xlsm").

'...
'Close Workbook
Stop                    '<- added
wb.Save
wb.Close False
'...

[o0omax]

At code name it say "this workbook" (see picture) but the full is the correct file path of the file "WB".

IMG_20220814_124156~2.jpg

Weirdly enough when I press F8 after the code stopped, the right workbook gets closed.

Sometimes if I execute the code manually, i get a pop up from Microsoft macro Security which I than have to click yes on (the code can't handle that because it's a security feature!!). Maybe that is the thing preventing the closing of the workbooks.

[rollis13]

Not sure if in the attached screenshot you are looking in the right place. When the macro stops all you have to do is hover over the variable ws and in a popup you should see it's contents. Elsewise, in the Immediate pane (Ctrl+G to show it) type: ?ws.name and you see the result.

Weirdly enough when I press F8 after the code stopped, the right workbook gets closed.

consequently, maybe I didn't understand you request, in post #1 you said:

The code is running fine, although I did not manage to close the opened Workbooks (wb).

So, which is the workbook that doesn't close ?

[Aussiebear]

@o0omax. I am puzzled by a number of sections of your code can you explain the thinking behind this one please?

CompanyName = myAr(k, 2)
'wenn ein andere Anzeigename gewünscht wurde -> überschreiben
If myAr(k, 3) = Empty Then
   Else
   CompanyName = myAr(k, 3)
End If
'Order erstellen
Dim folderName As String
folderName = SrcPath & "\" & Datum & "_" & CompanyName & "-" & CompanyNumber
MkDir (folderName)

Translating the commented out line it suggests that a second Company name can be entered if desired. Since both CompanyName refers to cells K2 and K3, How does the folderName line of code know which cell to use when compiling the folder name?

[Aussiebear]

Whilst we are on the above section of code the lines as seen here seem to be running in vagueness

If myAr(k, 3) = Empty Then
   Else
   CompanyName = myAr(k, 3)
End If

I'm not sure why you need an "else" here given that there is really only two options. Either you have already pre filled the cell with the value "Empty" or its " ". Either way you are requiring a second Company Name to be applied.

[Aussiebear]

Yet another puzzle is this line of code

Call CopyPaste(wb, PPpres, CompanyName, CompanyNumber)

How does the item CompanyName know what the relevant section of data is given that it refers to two cells? Could this be the reason it fails at this line?

[snb]

Why so complicated?

Just look: https://www.clever-excel-forum.de/Forum-Excel

[o0omax]

@rollis13

consequently, maybe I didn't understand you request, in post #1 you said: The code is running fine, although I did not manage to close the opened Workbooks (wb).

Thanks for the debugging advice. wb.close adresses the correct Workbook. When exceuting the code automatically (running it), wb.close does not work and it is still opened. When i excecute it step by step (with F8) at some Point Microsoft Macro Security Window pops up, which I have to accept. THEN IT WORKS and wb.close peprforms correctly. I tested out the code on a different machine (without comppany security policy) and it worked completely fine!

The fix would be now to ensure the file ist in a trusted location or sign the document.

@Aussiebar
Sure I can explain it. In the Worksheet "Automation Tool" the user can enter the Company Number in the first column of a table and with Index Match it will get the Company name in the second solumn of the table, e.G. "WheelFixer GmbH&co. KG". If the user of the macro wants to have the folder and file names just as "WheelFixer" he/she has to put in the new company name in the third column of the table. The whole data of the table will be transformed to myAr. Therefore companyName has no two cells, it takes the name of one cell (index match) but if the user typed in a different name, it will take that name. CompanyName will be overwritten.

@snb
The link points to a different Excel Forum, but not a specific entry. What did you want to show me?

Thank you everybody!

[rollis13]

Maybe if you attach a screenshot of the "Microsoft Macro Security Window" popup, just to try to figure out which of the hundreds that pop up with Office. But as you said, since it's probably due to the company's security policy, it might be hard to get around.

[snb]

It looks as if you are Germany based.

[Jan Karel Pieterse]

Sounds Excel is re-opening the file you just closed. Are any application.OnTime procedures present in the workbook you assigned to that wb variable by any chance?

[o0omax]

@rollis13

Maybe if you attach a screenshot of the "Microsoft Macro Security Window" popup, just to try to figure out which of the hundreds that pop up with Office. But as you said, since it's probably due to the company's security policy, it might be hard to get around.

When the file will be signed, will every saved copy of it will be signed? Im not sure if i can get it signed, because company policy is very strict on things like that.

macroSec.jpg

@snb

It looks as if you are Germany based.

yes Im German based, but what has that to do with my code being complicated? If so, I am always happy with performance suggestions.

@Jan Karel Pieterse

Sounds Excel is re-opening the file you just closed. Are any application.OnTime procedures present in the workbook you assigned to that wb variable by any chance?

no there is no Applicatication.OnTime in my code.

I moved the file to my shared Documents Folder (OneDrive) and now sometimes it works (all opened workbooks are closed in the end) but sometimes one or so is still opened. Maybe here the problem is with the OneDrive synchronisation, which uploads every file seperatly.

Is there a way to use getobject instead of open Excel? Or to maybe create for each new file a new excel application which then is closed with Application.Quit? Just brainstorming about a workaround.

[rollis13]

I'm sorry but I have no experience on how to get around this type of reporting. I give up and pass the hand to a real Excel expert.

[snb]

Why don't you designate the location where these files are stored as a 'safe' location in the Trust Center ?
What is wrong with these files that they are being categorized as unsafe ?
What brings application.displayalerts=false ?

You'd better post this question in the german clever excel forum.

[o0omax]

Why don't you designate the location where these files are stored as a 'safe' location in the Trust Center ?
What is wrong with these files that they are being categorized as unsafe ?
What brings application.displayalerts=false ?

You'd better post this question in the german clever excel forum.

Im not sure what categorizes them as unsafe. When i first started programatically deleting worksheets, those security messages started appearing. The trusted location settings says that the companies Main FileShare is a Trusted Location. Is this SharePoint then?

with application.displayalerts=false i tried to enhance performance, but this probably wont do it.

[Jan Karel Pieterse]

There is nothing odd about that dialog, it is the standard "enable macro's" dialog which pops up if you open any file WHILE THE VBA EDITOR IS OPEN (any file with VBA code which has not yet been trusted by clicking enable macro's).
So, something causes a workbook with macro's to be opened in Excel.

Which add-ins do you have loaded?

[o0omax]

There is nothing odd about that dialog, it is the standard "enable macro's" dialog which pops up if you open any file WHILE THE VBA EDITOR IS OPEN (any file with VBA code which has not yet been trusted by clicking enable macro's).
So, something causes a workbook with macro's to be opened in Excel.

Which add-ins do you have loaded?

I don't have any add ins loaded but i use a userForum as a ProgressBar.

Yes, i save ThisWorkbook As a Copy and open that copy to make changes (i do this because i want to have a copy of ThisWorkbook, with some minor changes such as deleting things, changing a diagram).

You can search my code for those two line:

wbSrc.SaveCopyAs (folderName & "\" & DateiName & ".xlsm")
'some code inbetween
Set wb = Workbooks.Open(folderName & "\" & DateiName & ".xlsm")