• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 639
  • Last Modified:

Script using excel to complie a New Workbook

I have developed a script which goes into a shared folder and opens up N workbooks and copies sheet 1 from each of N to a master workbook.  As it copies into the Master workbook it creates a sheet that has all of the worksheets data on it with an added column of Producer which is grapped from the file name.  The problem that I am having is with formatting the Master Sheet's page breaks I can add a page break where I want it however I can not remove the Automatic PageBreak that is inserted by execl.  Not the sub format master which contains the insertion of the page break.  I have tried to preformatt the worksheet with the initalizemaster sub to set pagebreaks to none.   Any help would be apperciated.  The complete script is below.

'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 2007
'
' NAME: Consolodate PipeLine XlS
'
' AUTHOR: John Finner , Gateway Bank and Trust
' DATE  : 6/16/2008
'
' COMMENT: This will consoldate Pipeline Spreadsheets into one master sheet
'
'==========================================================================
'Global Variables
'=============================================================================================
Dim objExcel,objMasterWorkbook,objMasterWorksheet,objFso,objRange
Dim strPath,strdrive,i
Dim ArrFiles
Dim IntBookMark
'=============================================================================================
'Initialize Globals
'=============================================================================================
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True 'set to true for debug
Set objMasterWorkbook = objExcel.Workbooks.Add
Set objFSO = CreateObject("Scripting.FileSystemObject")
strdrive = "b:"
strPath = "\\ec01XPAdmin01\temp"
i = 0
IntBookMark = 2
InitializeMaster()
drivemapper strdrive,strPath
GetFileNames (strdrive+"\")

'Process PipeLines
'=============================================================================================
Do While i <> UBound(ArrFiles)
ProcessUserPipeline strdrive+"\"+ArrFiles(i),ArrFiles(i)
i = i +1
IntBookMark = IntBookMark + 1
Loop
'=============================================================================================

FormatMaster ()
CleanUp()
Sub InitializeMaster()

Set objMasterWorksheet = objMasterWorkbook.Worksheets(1)
objMasterWorksheet.Cells.PageBreak = xlPageBreakNone
With objMasterWorksheet
.name = "Master List"

End With

With objMasterWorkbook
.Worksheets("sheet2").delete
.Worksheets("sheet3").delete
End With

With objExcel
.Cells(1,1).value = "Producer"
.Cells(1,2).value = "Prospect"+Chr(10)+"Name"
.Cells(1,3).value = "Lead"+Chr(10)+" Source"
.Cells(1,4).value = "Exp."+Chr(10)+" Date"
.Cells(1,5).value = "Stage"
.Cells(1,6).value = "Total"+Chr(10)+" Revenue"
.Cells(1,7).value = "%"
.Cells(1,8).value = "Expected"+Chr(10)+"Revenue"
.Cells(1,9).value = "Comments"
End With
Set objRange = objExcel.Range("A1:I1")
With objRange
.Interior.ColorIndex = 1
.Font.ColorIndex =2
.Font.Size =10
.Font.Bold = True
End With


End Sub
Sub ProcessUserPipeline (strFileName,strSheetName)
'Global Dependancies
'=============================================================================================
'objExcel,objMasterWorkBook,objMasterWorkSheet
'=============================================================================================
'Variables
'=============================================================================================
Dim objSlaveWorkSheet
Dim IntStartingPoint,IntEndingPoint,intLoopControl
'=============================================================================================
strSheetName = MakeWorkSheetName(strSheetName)
intLoopControl = 2
'WScript.Echo strSheetName 'debug
'Copy Work Sheet
'=============================================================================================
WScript.Echo "File Name "&strFileName
With objExcel
.Workbooks.Add(strFileName)
.Workbooks(IntBookMark).worksheets(1).copy(objMasterWorkbook.Worksheets(1))
End With
'=============================================================================================
'Rename Worksheet
'=============================================================================================
Set objSlaveWorkSheet = objMasterWorkbook.Worksheets(1)
objSlaveWorkSheet.name = strSheetName
'=============================================================================================
'Copy Data to Master Worksheet
'=============================================================================================
IntStartingPoint = FindEndOfSheet (objMasterWorksheet)
IntEndingPoint = FindEndOfSheet (objSlaveWorkSheet) 'this may be wrong -1
WScript.Echo IntStartingPoint
WScript.Echo "Ending Point for "&strSheetName&" "&IntEndingPoint
Do While intLoopControl <> IntEndingPoint
      objMasterWorksheet.Cells(IntStartingPoint,1).value = strSheetName
      objMasterWorksheet.Cells(IntStartingPoint,2).value = objSlaveWorkSheet.Cells(intLoopControl,1)
      objMasterWorksheet.Cells(IntStartingPoint,3).value = objSlaveWorkSheet.Cells(intLoopControl,2)
      objMasterWorksheet.Cells(IntStartingPoint,4).value = objSlaveWorkSheet.Cells(intLoopControl,3)
      objMasterWorksheet.Cells(IntStartingPoint,5).value = objSlaveWorkSheet.Cells(intLoopControl,4)
      objMasterWorksheet.Cells(IntStartingPoint,6).value = objSlaveWorkSheet.Cells(intLoopControl,5)
      objMasterWorksheet.Cells(IntStartingPoint,7).value = objSlaveWorkSheet.Cells(intLoopControl,6)
      objMasterWorksheet.Cells(IntStartingPoint,8).value = objSlaveWorkSheet.Cells(intLoopControl,7)
      objMasterWorksheet.Cells(IntStartingPoint,9).value = objSlaveWorkSheet.Cells(intLoopControl,8)
      intLoopControl = intLoopControl + 1
      IntStartingPoint = IntStartingPoint + 1
Loop
'=============================================================================================
End Sub
Function MakeWorkSheetName (strtmp)
strtmp = replace(strtmp,".xls","")
MakeWorkSheetName= strtmp
End Function
Function FindEndOfSheet (objTempSheet)
Dim strEOS
strEOS = 1
Do Until Len(objTempSheet.cells(strEOS,1).value) = 0
      strEOS = strEOS + 1
Loop
FindEndOfSheet = strEOS
End Function
Sub GetFileNames(strFolderToGet)
'Dependancies
'=============================================================================================
'ObjFso as File system Object
'ArrFiles
'=============================================================================================
'Variables
'=============================================================================================
Dim objFolder,objFiles
Dim strFileList
'=============================================================================================
'Build File List into a String
'=============================================================================================
Set objFolder = objFSO.GetFolder (strFolderToGet)
Set objFiles = objFolder.files
For Each file In objFiles
      strFileList = file.name+";"+strFileList
Next
'=============================================================================================
ArrFiles = Split(strFileList,";")
End Sub
Sub drivemapper (drive,share)
'Map Network drive
Dim network,drives,i
Set network = WScript.CreateObject("WScript.Network")
Set drives = network.EnumNetworkDrives
For i=0 to drives.count -1 Step 2
If LCase(drive)= LCase(drives.item(i)) Then
network.RemoveNetworkDrive drive, True,True
End If
Next
network.MapNetworkDrive drive, share
End Sub
Sub CleanUp ()
Dim objNetwork
Set objNetwork = WScript.CreateObject("WScript.Network")

objNetwork.RemoveNetworkDrive strDrive
End Sub
Sub ScreenPrintArray (arrTemp)
'This Prints out any arr elements
'Variables
'=============================================================================================
Dim intArraySize,i
'=============================================================================================
'Initialize Variables
'=============================================================================================
i=0
intArraySize = UBound (arrTemp)
'=============================================================================================
WScript.Echo "There are "&intArraySize&" elements in the array"
Do While i <> intArraySize
      WScript.Echo "Element "&i &"is : "&arrTemp(i)
      i = i+1
Loop
End Sub
Sub FormatMaster
Const xlToRight = -4161
Const xlLandscape = 2
Const xlPageBreakNone = -4142
Const xlPageBreakManual  = -4135
Dim objActiveCell

Set objRange = objMasterWorksheet.UsedRange
objRange.EntireRow.Autofit()
objRange.EntireColumn.Autofit()

objMasterWorksheet.Cells.PageBreak = xlPageBreakNone

Set objRange = objMasterWorksheet.range("j1")
objRange.pageBreak = xlPageBreakManual
'Set objRange = objMasterWorksheet.range("F1")
'objRange.pageBreak = xlPageBreakManual
'Set objRange = objMasterWorksheet.range("F1")
'objRange.pageBreak = xlPageBreakNone

Set objRange = objMasterWorksheet.Range("D:D")
objRange.NumberFormat = "M/D/YYYY"
Set objRange = objMasterWorksheet.Range("F:F")
objRange.NumberFormat = "$#,##0.00"
objRange.pageBreak = xlPageBreakManual



With objMasterWorksheet
.pagesetup.CenterHeader = "&""Arial,Bold""&14Gateway Insurance Services, Inc." & Chr(10) & "Sales Pipeline Report"
.pagesetup.Orientation = xlLandscape
End With



End Sub
0
Mark Pavlak
Asked:
Mark Pavlak
1 Solution
 
purplepomegraniteCommented:
This question has already been asked and answered.  Depending upon your set-up, you may not be able to remove the automatic pagebreaks, but pretty much all the available options are detailed in this question: http://www.experts-exchange.com/Q_22056182.html
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now