Skip to main content
Announcements
Have questions about Qlik Connect? Join us live on April 10th, at 11 AM ET: SIGN UP NOW
cancel
Showing results for 
Search instead for 
Did you mean: 
Not applicable

Macro to save selection to multiple (more) excel files


Hi,

I'm trying to build macro to save selected object into excel file, but with for loop for each possible values for Salesman.

it works fine when You have only one selected, but when I have two or more it fells.

Here is example:

Sub SaveToExcel

Dim i

set obj = ActiveDocument.GetSheetObject("CH145")

SET StrWerk = ActiveDocument.Fields("Unit").GetSelectedValues

If StrWerk.Count > 1 Then

Msgbox("Only one unit")

ELSE
SET StrADM = ActiveDocument.Fields("Salesman").GetPossibleValues

for i= 0 to StrADM.count -1

         ActiveDocument.Fields("Salesman").Clear

        ActiveDocument.Fields("Salesman").Select StrADM.Item(i).Text

        ActiveDocument.GetApplication.WaitforIdle

        strDate = CDate(Date)

        strDay = DatePart("d", strDate)

        strMonth = DatePart("m", strDate)

       strYear = DatePart("yyyy", strDate)

        If strDay < 10 Then

        strDay = "0" & strDay

        End If

  If strMonth < 10 Then

    strMonth = "0" & strMonth

  End If

  GetFormattedDate = strMonth & "-" & strDay & "-" & strYear & "-" & StrWerk(0).text &"-" & StrADM(i).Text

Path = "E:\"

NewFileName = "Test_" & GetFormattedDate &".xlsx"

Msgbox(GetFormattedDate)

set XLApp = CreateObject("Excel.Application")

XLApp.Visible = true

set XLDoc = XLApp.Workbooks.Add

set rngStart = XLDoc.Sheets(1).Range("A1")

set XLSheet = XLDoc.Worksheets("Sheet1")

Const xlCenter = -4108

        obj.CopyTableToClipboard true

        XLDoc.WorkSheets("Sheet1").Paste()

               

     XLDoc.Sheets(1).Range("A1").Select

     XLDoc.WorkSheets("Sheet1").Cells.select

     XLDoc.WorkSheets("Sheet1").Cells.EntireRow.RowHeight = 12.75

     XLDoc.WorkSheets("Sheet1").Cells.EntireColumn.AutoFit

     set Selection = XLSheet.Columns("A:L")

With Selection

.VerticalAlignment = xlCenter

.Borders.ColorIndex = 0 'black border

End With

XLSheet.Name = "Test"

        XLDoc.Sheets(1).Range("A1").Select

XLDoc.SaveAs NewFileName

  'XLApp.Quit

Next

END IF

end sub   

What I am doing wrong?

Will appreciate any help

Best

Tom

1 Reply
Not applicable
Author


Hi,

I have found the solution.

In the Script, should be the code to clear all var and dim.

Set XLSheet = Nothing

SET XLDoc = NOTHING       

   SET XLApp = NOTHING 

   Set obj = nothing

And there was one constante Const xlCenter = -4108, but the number i've put into code (see below)

Corect version is like this

With Selection

.VerticalAlignment = -4108

.Borders.ColorIndex = 0 'black border

End With

Hope the will help somebody