So habe ich es geschafft, eine Vorlage zu verwenden, um mehrere Excel-Dateien zu erstellen, die als .xlsx-Datei gespeichert werden, um den Makro, um sicherzustellen, wird nicht als Teil der neu erstellten Dateien gespeichert. Allerdings, habe ich jetzt das Problem der Datenbankverbindungen, die in Makro aktualisiert werden. Wenn ich diese lösche, werden bei den folgenden Dateien die Daten aus der ursprünglichen Datei erstellt, wenn die Verbindungszeichenfolgen unterbrochen wurden. Es scheint, dass dieser Prozess so funktioniert, dass die nächste Datei aus der vorherigen, nicht aus der Vorlage erstellt wird - eine Art Bucket-Brigade-Ansatz. Jetzt weiß ich, dass die Leute mich fragen werden, was ich versucht habe, aber es hat ein paar Wochen gedauert, bis ich die Chance bekommen habe, an diesen Punkt zu kommen, und ich komme nicht weiter. Bitte Jungs, ich habe gegoogelt und alles ausprobiert, aber es ist jenseits von mir. Bitte können Sie helfen? Ich habe in meinen Code den Teil eingefügt, der die Verbindungen löscht - aber wie gesagt, dies ist nicht der richtige Ansatz, wie es scheint. DankeLöschen Datenbankverbindung in Excel-VBA-Makro
Sub Button3_Click()
Dim MyCell As Range, MyRange As Range
Dim LR As Long
If Dir("P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\", vbDirectory) = "" Then
MkDir Path:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\"
End If
If Dir("P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\Trust Code Files\", vbDirectory) = "" Then
MkDir Path:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\Trust Code Files\"
End If
LR = Range("A" & Rows.Count).End(xlUp).Row
'this gets the values for workbook names
Set MyRange = Range("A2:A" & LR).SpecialCells(xlCellTypeVisible)
Dim xConnect As Object
For Each MyCell In MyRange
'this populates a cell with the name in the range that the workbook then references for refreshing an MS query
Worksheets("Front Sheet").Cells(5, 5) = MyCell.Value
Worksheets("Front Sheet").Cells(5, 6) = MyCell.Offset(, 1).Value
Worksheets("Front Sheet").Cells(5, 7) = MyCell.Offset(, 2).Value
Worksheets("Front Sheet").Cells(5, 8) = MyCell.Offset(, 3).Value
Worksheets("Front Sheet").Cells(5, 9) = MyCell.Offset(, 4).Value
Application.DisplayAlerts = False
ActiveWorkbook.RefreshAll
ActiveWorkbook.Sheets("Speciality Score Card").Range("B7:D16").Interior.Color = RGB(251, 222, 5) 'light yellow
ActiveWorkbook.Sheets("Speciality Score Card").Range("B6:D6").Interior.Color = RGB(255, 192, 0) ' dark yellow
ActiveWorkbook.Sheets("Speciality Score Card").Range("E6:E6").Interior.Color = RGB(231, 25, 25) 'dark red
ActiveWorkbook.Sheets("Speciality Score Card").Range("E7:G16").Interior.Color = RGB(255, 0, 0) 'light red
ActiveWorkbook.Sheets("Speciality Score Card").Range("B17:D17").Interior.Color = RGB(0, 102, 0) 'dark green
ActiveWorkbook.Sheets("Speciality Score Card").Range("B18:D32").Interior.Color = RGB(0, 176, 80) 'light green
ActiveWorkbook.Sheets("Speciality Score Card").Range("E18:G32").Interior.Color = RGB(0, 88, 154) 'light blue
ActiveWorkbook.Sheets("Speciality Score Card").PivotTables("PivotTable3").DataBodyRange.Interior.Color = RGB(0, 88, 154) 'light blue
ActiveWorkbook.Sheets("Speciality Score Card").PivotTables("PivotTable3").RowRange.Interior.Color = RGB(0, 88, 154) 'light blue
ActiveWorkbook.Sheets("Speciality Score Card").Range("E17:G17").Interior.Color = RGB(0, 32, 96) 'dark blue
' ActiveWorkbook.Sheets("Overview Score Card").Range("C1").Copy
' ActiveWorkbook.Sheets("Overview Score Card").Range("C1").PasteSpecial (xlPasteValues)
ActiveWorkbook.Saved = True
ActiveWorkbook.Sheets("Members").Visible = False
ActiveWorkbook.Sheets("Front Sheet").Visible = False
Worksheets("Graphs Red Zone").PageSetup.CenterFooter = Worksheets("Overview Score Card").Range("A4:F4").Value
Worksheets("Graphs Blue Zone").PageSetup.CenterFooter = Worksheets("Overview Score Card").Range("A4:F4").Value
Worksheets("Graphs Yellow Zone").PageSetup.CenterFooter = Worksheets("Overview Score Card").Range("A4:F4").Value
Worksheets("Graphs Green Zone").PageSetup.CenterFooter = Worksheets("Overview Score Card").Range("A4:F4").Value
ActiveWorkbook.SaveAs Filename:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\" & "CNST - " & MyCell.Value & " " & Format(Now(), "dd-mmm-yyyy") & ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.SaveAs Filename:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\Trust Code Files\" & MyCell.Offset(, 5).Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook
Dim wkb As Workbook
Set wkb = Workbooks.Open(Filename:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\" & "CNST - " & MyCell.Value & " " & Format(Now(), "dd-mmm-yyyy") & ".xlsx")
Dim wkb2 As Workbook
Set wkb2 = Workbooks.Open(Filename:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\Trust Code Files\" & MyCell.Offset(, 5).Value & ".xlsx")
Application.DisplayAlerts = True
Next MyCell
' this deletes connections
For Each xConnect In wkb.Connections
If xConnect.Name <> "ThisWorkbookDataModel" Then xConnect.Delete
Next xConnect
For Each xConnect In wkb2.Connections
If xConnect.Name <> "ThisWorkbookDataModel" Then xConnect.Delete
Next xConnect
ActiveWorkbook.Close
End Sub
Beachten Sie, dass jede cell_ _For In 'MyRange' Sie öffnen' wkb' und 'wkb2'. Das scheint falsch zu sein. Und Sie speichern die Arbeitsmappe nach dem Formatieren jeder Zelle. –
"_die nächste Datei wird aus der vorherigen erstellt, nicht aus der Vorlage_" Ja, das ist, weil Sie Ihre aktive Arbeitsmappe weiter verwenden. –
@Paul Hi Paul - danke für die Klärung, warum es das tut - wie würde ich es dann jedes Mal zur Vorlage zurückkehren lassen? – AJCT