1 Reply Latest reply: Aug 5, 2014 9:31 AM by Jandré Killian RSS

    AutoFit Columns in Excel Sheet Export

    Brian Garside

      I need to Auto Fit a sheet of columns after they are exported. Can anybody help me on this.

      should only be one line or two?

       

      Below is the code I have.

      Excerpt:

      '//VBA Works, but not here since its VBScript

      Cells.Select

          Cells.EntireColumn.Autofit

       

      '// Worksheets(“Loaned Still Out Report").Columns(A:I).AutoFit

       

      Full script

      '// ****************************************************************

      '// Export of multiple objects in different formats (data & image)

      '// In one case (sheet "Sales Overview") two objects are placed on

      '// one sheet.

      '// ****************************************************************

      sub exportToExcel_Variant3

       

       

      Dim aryExport(2,3)

       

       

       

       

      aryExport(0,0) = "CH178"

      aryExport(0,1) = "Asset Value Chart"

      aryExport(0,2) = "A1"

      aryExport(0,3) = "image"

       

       

      aryExport(1,0) = "CH179"

      aryExport(1,1) = "Asset Value Chart"

      aryExport(1,2) = "A25"

      aryExport(1,3) = "image"

       

       

      aryExport(2,0) = "CH180"

      aryExport(2,1) = "Loaned Still Out Report"

      aryExport(2,2) = "A1"

      aryExport(2,3) = "data"

       

       

      Dim objExcelWorkbook 'as Excel.Workbook

      Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

       

      'VBA Works, but not here since its VBScript

      Cells.Select

          Cells.EntireColumn.Autofit

       

      'Worksheets(“Loaned Still Out Report").Columns(A:I).AutoFit

       

       

      '// Now either just leave Excel open or do some other stuff here

      '// like saving the excel, some formatting stuff, ...

       

       

      end sub

       

       

       

       

       

       

       

       

       

       

      '// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      '// YOU DO NOT NEED TO CHANGE THE CODE BELOW !!!!!!!!!!!!!!!!!!!!!!!

      '// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

       

       

       

       

      '// ****************************************************************

      '// copyObjectsToExcel

      '// ~~

      '// Parameters:

      '// qvDoc - Reference to the QlikView document (normally just use

      '// "ActiveDocument", but you can also use copyObjectsToExcel

      '// outside of QlikView ...

      '// aryExportDefinition - array of settings

      '// ~~

      '// Version 1.02

      '// ~~

      '// The aryExportDefinition is used to pass the following properties to

      '// copyObjectsToExcelSheet:

      '//

      '//   Index Description

      '// ------------------------

      '// 0 - Id of the QlikView object to copy from

      '// 1 - Name of the sheet (in Excel) where the object should be copied to

      '//

      '// (If a sheet with the same name already exists no new

      '// sheet will be created, instead the existing sheet will

      '// be used for pasting the object)

      '//

      '// Note: the sheetName can be max 31 characters long

      '//

      '// 2 - Range in Excel where the object should be pasted to

      '// 3 - PasteMode ["data", "image"]

      '// Defines if the objects underlaying data should be

      '// pasted ("data") or the the image representing the object

      '// should be used

      '// ****************************************************************

      Private Function copyObjectsToExcelSheet(qvDoc, aryExportDefinition) 'as Excel.Workbook

       

       

       

       

      Dim i 'as Integer

      Dim objExcelApp 'as Excel.Application

      Dim objExcelDoc 'as Excel.Workbook

       

       

      Set objExcelApp = CreateObject("Excel.Application")

       

       

      objExcelApp.Visible = true 'false if you want to hide Excel

      objExcelApp.DisplayAlerts = false

       

      Set objExcelDoc = objExcelApp.Workbooks.Add

       

       

      Dim strSourceObject

       

       

      Dim qvObjectId 'as String

      Dim sheetName

      Dim sheetRange

      Dim pasteMode

      Dim objSource

      Dim objCurrentSheet

      Dim objExcelSheet

       

       

       

       

       

       

      for i = 0 to UBOUND(aryExportDefinition)

       

       

        '// Get the properties of the exportDefinition array

        qvObjectId = aryExportDefinition(i,0)

        sheetName = aryExportDefinition(i,1)

        sheetRange = aryExportDefinition(i,2)

        pasteMode = aryExportDefinition(i,3)

                    

        Set objExcelSheet = Excel_GetSheetByName(objExcelDoc, sheetName)

        if (objExcelSheet is nothing) then

        Set objExcelSheet = Excel_AddSheet(objExcelApp, sheetName)

        if (objExcelSheet is nothing) then

        msgbox("No sheet could be created, this should not occur!!!")

        end if

        end if

                    

          objExcelSheet.Select          

       

       

        set objSource = qvDoc.GetSheetObject(qvObjectId)

        Call objSource.GetSheet().Activate()

        objSource.Maximize

        qvDoc.GetApplication.WaitForIdle

       

       

        if (not objSource is nothing) then

       

        if (pasteMode = "image") then

        Call objSource.CopyBitmapToClipboard()

        else

        Call objSource.CopyTableToClipboard(true) '// default & fallback

        end if

       

        Set objCurrentSheet = objExcelDoc.Sheets(sheetName)

        objExcelDoc.Sheets(sheetName).Range(sheetRange).Select

        objExcelDoc.Sheets(sheetName).Paste

       

        if (pasteMode <> "image") then

        With objExcelApp.Selection

                  .WrapText = False

                  .ShrinkToFit = False

        End With                   

        end if      

       

        objCurrentSheet.Range("A1").Select  

        end if

       

       

                   

                   

      next  

       

       

      Call Excel_DeleteBlankSheets(objExcelDoc)

       

       

      '// Finally select the first sheet

      objExcelDoc.Sheets(1).Select

       

       

      '// Return value

      Set copyObjectsToExcelSheet = objExcelDoc

       

       

      end function

      '// ________________________________________________________________

       

       

       

       

       

       

      '// ****************************************************************

      '// Internal function for getting the Excel sheet by sheetName

      '// ****************************************************************

      Private Function Excel_GetSheetByName(ByRef objExcelDoc, sheetName) 'as Excel.Sheet

       

       

      For Each ws In objExcelDoc.Worksheets

        If (trim(ws.Name) = Excel_GetSafeSheetName(sheetName)) then

        Set Excel_GetSheetByName = ws

        exit function

        End If

      Next

       

       

      '// default return value

      Set Excel_GetSheetByName = nothing

                                 

      End Function

      '// ________________________________________________________________

       

       

       

       

      Private Function Excel_GetSafeSheetName(sheetName)

       

       

        '// can be max 31 characters long

        retVal = trim(left(sheetName, 31))

       

        Excel_GetSafeSheetName = retVal

      End Function

       

       

       

       

       

       

      '// ****************************************************************

      '// Internal function for adding a new sheet

      '// ****************************************************************

      Private Function Excel_AddSheet(objExcelApplication, sheetName) ' as Excel.Sheet

       

       

        '// add a sheet to the last position

        objExcelApplication.Sheets.Add , objExcelApplication.Sheets(objExcelApplication.Sheets.Count)

       

        Dim objNewSheet

        Set objNewSheet = objExcelApplication.Sheets(objExcelApplication.Sheets.Count)

        objNewSheet.Name = left(sheetName,31)

       

        '// return the newly created sheet

        Set Excel_AddSheet = objNewSheet

       

       

      End function

      '// ________________________________________________________________

       

       

       

       

       

       

      '// ****************************************************************

      '// Delete all empty sheets

      '// ****************************************************************

      Private Sub Excel_DeleteBlankSheets(ByRef objExcelDoc)

       

       

      For Each ws In objExcelDoc.Worksheets

        If (not HasOtherObjects(ws)) then

        If objExcelDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then

        On Error Resume Next

        Call ws.Delete()

        End If

        End If

      Next

        

      End Sub

      '// ________________________________________________________________

       

       

       

       

       

       

       

       

      '// ****************************************************************

      '// Helper function to determine if there are other objects placed

      '// on the sheet ...

      '// ****************************************************************

      Public Function HasOtherObjects(ByRef objSheet) 'As Boolean

          Dim c

          If (objSheet.ChartObjects.Count > 0) Then

          HasOtherObjects = true

          Exit function

          End If

          If (objSheet.Pictures.Count > 0) Then

          HasOtherObjects = true

          Exit function

          End If

          If (objSheet.Shapes.Count > 0) Then

          HasOtherObjects = true

          Exit function

          End If

        

        

          HasOtherObjects = false

      End Function

      '//__________________________________________________________________

        • Re: AutoFit Columns in Excel Sheet Export
          Jandré Killian

          Hi

           

          Set obj = ActiveDocument.GetSheetObject("CH02")

              

               XLApp.ActiveWorkbook.Sheets(2).Activate

             

                  obj.CopyTableToClipboard true

                  XLApp.ActiveWorkbook.Sheets(2).Range("A1").Select

                  XLDoc.Sheets(2).Paste()

                 

            

                  set Selection =   XLDoc.Sheets(2).Columns("A:N")

          With Selection

          .Borders.ColorIndex = 0

          .EntireRow.RowHeight = 12.75

          .AutoFit

           

           

           

           

            

          End With