D
deltaquattro
Hi,
I have a workbook which I populate with many worksheets, some of which
are PivotCharts. I would like to export them to a new workbook, but
I'm finding some difficulties. First of all, I have to collect all the
sheets to be moved in a Collection, or to store their names in a
String array, so that the ExportSheets subroutine will know which
sheets to export (btw, which approach would you suggest? I chose the
first one but I'm not sure it's the best).
My naive attempt at ExportSheets didn't really do what I needed:
Sub ExportSheets(shtColn As Collection, wbkName As String, wbk As
Workbook)
'Move the sheets in collection shtColn to workbook wbkName, creating
it if it is missing, and
'returning the reference to it
Dim sht As Object
'Add workbook
Call AddWorkbook(wbkName, wbk)
'Export sheets
For Each sht In shtColn
sht.Move After:=wbk.Sheets(Sheets.count)
Next
End Sub
(below you can find source code for AddWorkBook). I indeed obtain a
new wbk in which all the sheets are stored, but the PivotCharts are
not anymore linked to the sheet containing the PivotTables, so I
cannot modify them interactively clicking on the Field Buttons. I
guess I should move all the sheets together with a single instruction,
so as to preserve their relationships...is there a way to do a "mass"
Move? As always, general suggestions on coding style are well
received. Thanks,
Best Regards,
Sergio Rossi
--------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub AddWorkbook(wbkName As String, wbk As Workbook)
' Add the workbook wbkName to the Workbooks collection and returns the
reference:
' - if a workbook with the same name is open, the reference to it is
returned;
' - otherwise, a workbook is opened and saved with name wbkName
Dim FileName As String, Path As String, FullName As String
'Check if wbkName is already opened
FileName = wbkName & ".xls"
If IsWorkbookOpen(FileName) Then
Set wbk = Workbooks(FileName)
wbk.Activate ' for consistency with the case in which the workbook
is actually added
Else
' Add workbook and save it with requested name
Path = ActiveWorkbook.Path
FullName = Path & "\" & wbkName
Set wbk = Workbooks.Add
ActiveWorkbook.SaveAs FileName:=FullName
End If
End Sub
Function IsWorkbookOpen(wkbName As String) As Boolean
'bIsWorkbookOpen returns True if wkbName is a member
'of the Workbooks collection. Otherwise, it returns False
'wkbName must be provided as a file name without path
Dim wkb As Workbook
On Error Resume Next
Set wkb = Workbooks(wkbName)
If Not wkb Is Nothing Then
IsWorkbookOpen = True
End If
End Function
I have a workbook which I populate with many worksheets, some of which
are PivotCharts. I would like to export them to a new workbook, but
I'm finding some difficulties. First of all, I have to collect all the
sheets to be moved in a Collection, or to store their names in a
String array, so that the ExportSheets subroutine will know which
sheets to export (btw, which approach would you suggest? I chose the
first one but I'm not sure it's the best).
My naive attempt at ExportSheets didn't really do what I needed:
Sub ExportSheets(shtColn As Collection, wbkName As String, wbk As
Workbook)
'Move the sheets in collection shtColn to workbook wbkName, creating
it if it is missing, and
'returning the reference to it
Dim sht As Object
'Add workbook
Call AddWorkbook(wbkName, wbk)
'Export sheets
For Each sht In shtColn
sht.Move After:=wbk.Sheets(Sheets.count)
Next
End Sub
(below you can find source code for AddWorkBook). I indeed obtain a
new wbk in which all the sheets are stored, but the PivotCharts are
not anymore linked to the sheet containing the PivotTables, so I
cannot modify them interactively clicking on the Field Buttons. I
guess I should move all the sheets together with a single instruction,
so as to preserve their relationships...is there a way to do a "mass"
Move? As always, general suggestions on coding style are well
received. Thanks,
Best Regards,
Sergio Rossi
--------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub AddWorkbook(wbkName As String, wbk As Workbook)
' Add the workbook wbkName to the Workbooks collection and returns the
reference:
' - if a workbook with the same name is open, the reference to it is
returned;
' - otherwise, a workbook is opened and saved with name wbkName
Dim FileName As String, Path As String, FullName As String
'Check if wbkName is already opened
FileName = wbkName & ".xls"
If IsWorkbookOpen(FileName) Then
Set wbk = Workbooks(FileName)
wbk.Activate ' for consistency with the case in which the workbook
is actually added
Else
' Add workbook and save it with requested name
Path = ActiveWorkbook.Path
FullName = Path & "\" & wbkName
Set wbk = Workbooks.Add
ActiveWorkbook.SaveAs FileName:=FullName
End If
End Sub
Function IsWorkbookOpen(wkbName As String) As Boolean
'bIsWorkbookOpen returns True if wkbName is a member
'of the Workbooks collection. Otherwise, it returns False
'wkbName must be provided as a file name without path
Dim wkb As Workbook
On Error Resume Next
Set wkb = Workbooks(wkbName)
If Not wkb Is Nothing Then
IsWorkbookOpen = True
End If
End Function