EBDN - Community - Question & Answers

  Wednesday, 21 March 2018
  2 Replies
  1.2K Visits
0
Votes
Undo
Hallo Zusammen,

mit dem folgenden Code lösche ich Vorlagenblätter aus meinen Projekten und ersetze diese mit den aktuellen.

Sub UpdateSheets()
Dim oProjectSelection As ObjectItem
Dim oProject As Project
Dim oTempSheets As ObjectItems
Dim oActProject As Project
Dim oSheet As ObjectItem
Dim oPath As ObjectItem
Dim bFirstRun As Boolean

For Each oProjectSelection In Application.Selection
bFirstRun = False

Set oProject = Application.Folders.ProjectTemplates.FindObjects(aucObjProject, aucSearchHierarchical, 0, aucAttrDesignation, aucCondEqual, cPrjName)(1)

Set oTempSheets = oProject.TemplatesFolder.FindObjects(aucObjSheet, aucSearchHierarchical)
Set oActProject = oProjectSelection 'Application.Selection(1)

For Each oSheet In oActProject.TemplatesFolder.FindObjects(aucObjSheet, aucSearchHierarchical)
If Not bFirstRun Then
bFirstRun = True
Set oPath = oSheet.Parent
End If
oSheet.Delete
Next

'If Not bFirstRun Then
' bFirstRun = True
' Set oPath = oActProject.TemplatesFolder.Kind
' FindObjects(aucObjFavoriteForms, aucSearchDeep, , , , "Favoriten";)
'End If

For Each oSheet In oTempSheets
oSheet.CopyTo oPath, True
Next

RecycleBin
Next

End Sub

Das Problem ist:
Das wenn ich keine Blätter in den Vorlagen abgelegt habe funtioniert folgende Codezeilen nicht:

For Each oSheet In oActProject.TemplatesFolder.FindObjects(aucObjSheet, aucSearchHierarchical)
If Not bFirstRun Then
bFirstRun = True
Set oPath = oSheet.Parent
End If

Somit habe ich versucht mit folgendem Codezeilen den Pfad direkt zu setzen:

'If Not bFirstRun Then
' bFirstRun = True
-> ' Set oPath = oActProject.TemplatesFolder.Kind
-> ' FindObjects(aucObjFavoriteForms, aucSearchDeep, , , , "Favoriten";)
'End If

Hier habe ich aber einen Fehler / alle was ich versuch führt nicht zum gewünschten Ergebeniss.

Achtung: Makro funktioniert sonst prima.

Kann mir da jemand helfen?