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

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:

Code:

---

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.       
            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   
            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:

Code:

---

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

---

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

Code:

---

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:

Code:

---

Set wb = ThisWorkbook

---

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

Code:

---

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.

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

Code:

---

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.

Code:

---

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:

Code:

---

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

---

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").

Code:

---

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

---

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

Attachment 30051

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.

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.

Quote:

---

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:

Quote:

---

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 ?

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

Code:

---

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?

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

Code:

---

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.

Yet another puzzle is this line of code

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?

Why so complicated?

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

@rollis13

Quote:

---

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!

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.

It looks as if you are Germany based.

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?

@rollis13

Quote:

---

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.

Attachment 30057

@snb

Quote:

---

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

Quote:

---

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.

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.

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.

Quote:

---

Originally Posted by 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.

---

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.

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?

Quote:

---

Originally Posted by 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?

---

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:

Code:

---

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

---