Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
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
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