Help with VBA needed

OTPM · #1 01-21-2014, 12:12 PM

Hi Forum Members
I need some help with some VBA code please. I have a piece of code in MS Project (PrintResourceCharts) which copies a predefined view. I then have a predefined template in Excel where I want to simply paste the copied data from MS Project using an WorkbookOpen macro which pastes the data onto a worksheet and save/close the workbook. However the code is simply opening multiple workbooks and not pasting anything in the worksheet. Any help would be appreciated:

Code:

Sub PrintResourceCharts()
'It will automatically adjust the timescale to show all of the resource's activities
'Create Task Lists
Dim r As Resource
Application.DisplayAlerts = False
ViewApply Name:="Steria Task Lists"
For Each r In ActiveProject.Resources
    If r.Assignments.Count > 0 Then
        mystring = r.Name
            FilterEdit Name:="Steria Task Lists", TaskFilter:=True, Create:=True, _
            OverwriteExisting:=True, FieldName:="Resource Names", test:="Contains exactly", _
            Value:=mystring, ShowInMenu:=False, ShowSummaryTasks:=False
            FilterApply "Steria Task Lists"
            
            SetAutoFilter FieldName:="Resource Names", FilterType:=pjAutoFilterIn, Criteria1:=mystring
            SelectTaskColumn Column:="Resource Names", Additional:=10
            EditCopy
            On Error Resume Next
            AppActivate ("Microsoft excel")
            Set ExcelSheet = CreateObject("Excel.Application")
            ExcelSheet.Application.Visible = True
            Set xlWB = ExcelSheet.Workbooks.Open("D:\Task List Templates\Task List.xlsm")
            xlApp.Visible = True
        FileSaveAs Name:="D:\Task List Templates\Task Lists\" & mystring & ".xls", FormatID:="MSProject.XLS5", map:="Steria Task Lists"
        ActiveWorkbook.Close
    End If
Next r
MsgBox ("Individual Resource Sheets have been produced.")
    ViewApply Name:="Gantt Chart"
Application.DisplayAlerts = True
End Sub

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'
'
Dim wbName
Application.DisplayAlerts = False
On Error Resume Next
    Range("A1").Select
    ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
        False
    wbName = Range("A2").Value
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:A").ColumnWidth = 14.43
    Columns("D:D").ColumnWidth = 34
    Columns("E:K").EntireColumn.AutoFit
    Columns("D:D").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    ChDir "D:\Task List Templates\Task Lists\"
    
    ActiveWorkbook.SaveAs Filename:="D:\Task List Templates\Task Lists\" & wbName & ".xls", FileFormat:=xlNormal, _
    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
    
'    ActiveWorkbook.SaveAs Filename:="D:\Task List Templates\Task Lists\" & wbName & ".xls", FileFormat:=xlNormal
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
End Sub

macropod · #2 01-22-2014, 03:56 AM

In your code you have:
On Error Resume Next
AppActivate ("Microsoft excel")
Set ExcelSheet = CreateObject("Excel.Application")
What this is doing is telling the macro to ignore any errors, activate the current Excel seesion (if this is one) then start another Excel session - regardless of whether Excel is already running ...

Defining the Excel application as 'ExcelSheet' is poor practice, as it could lead to confusion as to whether you're working with a worksheet or the application behind the workbook containing a worksheet. IMHO you should use something like 'xlApp' for the application, 'xlWkBk' for a workbook and 'xlWkSht' for a worksheet.

Subsequently, your lines:
FileSaveAs Name:="D:\Task List Templates\Task Lists\" & mystring & ".xls", FormatID:="MSProject.XLS5", map:="Steria Task Lists"
ActiveWorkbook.Close
are unqualified, in that they don't refer to either the owning application or the particular workbook (i.e. as defined by 'xlWB').

OTPM · #3 01-22-2014, 06:42 AM

Hi Paul
Many thanks for your prompt response. As you can see I am not a VBA expert. I have simply copied code from elsewhere and tried to modify it to achieve my aim.
I will try your suggestions this evening and see where that gets me.
Thanks again.
Tony

macropod · #4 01-22-2014, 02:44 PM

For some code to automate Excel from Word, see:
https://www.msofficeforums.com/word-...html#post34254
The code there is only concerned with a single Excel workbook (which gets closed and the Excel session terminated, if applicable, immediately the data have been harvested), but the principles for multiple workbooks are the same (just don't run the termination code until your processing is done). An important consideration for your purposes is that you should put the code that automates Excel outside the processing loop, then just use the looping to open/modify the workbook(s).

From what I understand of your code, you seem to be modifying a single workbook over and over. For that, you could re-open the workbook for each loop, or you could simply keep the same workbook open and just modify it before saving it with the new name.

OTPM · #5 01-23-2014, 12:58 PM

Thanks for the advice/help Paul.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Help Needed	MdCadle	PowerPoint	1	08-24-2013 09:14 AM
If-Then help needed	sammipd	Mail Merge	1	04-24-2013 04:38 AM
Serious help needed.	karlyak22	Outlook	0	11-13-2011 07:32 AM
help needed!!!	thunder14	Word	1	10-17-2009 02:57 PM
Help needed :)	thechief55	PowerPoint	1	04-28-2009 01:25 PM