Excel dosya açma save etme

************************************************************

* Function CombineExcelFiles

************************************************************

* Created...........: Craig Boyd 3/6/2006 23:55:50

*) Description.......:

* Calling Samples...: DIMENSION aXLSFiles(3)

*!*                    aXLSFiles(1) = "C:\temp1.xls"

*!*                    aXLSFiles(2) = "C:\temp2.xls"

*!*                    aXLSFiles(3) = "C:\temp3.xls"

*!*                    CombineExcelFiles(@aXLSFiles, "C:\XLSCombined.xls")

* Parameter List....:

* Major change list.:

function CombineExcelFiles (taXLSFiles, tcDestination, tlDeleteOriginal)

external array taXLSFiles

local loExcel as Excel.application, ;

    loWorkBook as Excel.Worksbook, ;

    loWorkSheet , ;

    lnCounter, lcWorkSheetCaption, lcError, ;

    lcValidChars

 

lcError = ""

 

try

    lcValidChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 "

    loExcel = newobject("Excel.Application")

    with loExcel

        .ScreenUpdating = .f.

        .DisplayAlerts = .f.

        .WorkBooks.add()

        lnCounter = 0

 

** Delete all existing worksheets except 1

        for each loWorkSheet in .WorkBooks(1).WorkSheets

            lnCounter = m.lnCounter + 1

            if m.lnCounter > 1

                loWorkSheet.delete

            endif

        endfor

 

        for lnCounter = 1 to alen(taXLSFiles,1)

            if file(taXLSFiles[m.lnCounter])

                lcWorkSheetCaption = juststem(taXLSFiles[m.lnCounter])

                loWorkBook = .WorkBooks.open(taXLSFiles[m.lnCounter])

                loWorkBook.WorkSheets(1).copy(null, ;

                    .WorkBooks(1).WorkSheets(.WorkBooks(1).WorkSheets.count))

                .WorkBooks(1).ActiveSheet.name = ;

                    right(alltrim(chrtran(m.lcWorkSheetCaption, ;

                    chrtran(m.lcWorkSheetCaption,m.lcValidChars,"")," ")), 31) &&loWorkBook.Name

                loWorkBook.close(.f.) && Do not save changes

                if m.tlDeleteOriginal

                    erase (taXLSFiles[m.lnCounter])

                endif

            endif

        endfor

** Remove the first original sheet from (Sheet1)

        .WorkBooks(1).WorkSheets(1).delete

 

        .WorkBooks(1).saveas(m.tcDestination)

        .ScreenUpdating = .t.

        .DisplayAlerts = .t.

    endwith

 

catch to loError

    lcError = Log_Error(m.loError)

finally

    if vartype(m.loExcel) = 'O'

        with loExcel

            .ScreenUpdating = .t.

            .DisplayAlerts = .t.

            .quit()

        endwith

    endif

endtry

 

return m.lcError

endfunc

If  Isblank(This.Dosyad)  && dosya adi yok getfile ile seçilebilinecek

  Wait Nowait Window "dosya seçerseniz sayfa eklenecek"+Chr(13)+"ve seçili ad ile saklanacak";

    +Chr(13)+Chr(13)+"seçmezseniz "+Addbs(This.Dizinad)+This.Dosyad+".xls dosyasi olusturulacak"

  m.Dosyad=Getfile("xls","excel dosyasI seçin","seç",1,"SEÇIM YAPMAZSANIZ YENI DOSYA OLUSTURULACAK")

  m.yenidosya= Isblank(m.Dosyad) Or !File(m.Dosyad)

  If Isblank(m.Dosyad)   && GETFILE() ile seçmedik

    m.Dosyad=Addbs(This.Dizinad)+"DosyaAdGirilmedi.xls"

    m.Dosyad=Chrtran(m.Dosyad,"öÖYüÜsSgGçÇ() ","oOIuUSsgGcC")

  Endif

Else  && dosya adi geçirilmis

  m.Dosyad=Addbs(This.Dizinad)+This.Dosyad

  m.yenidosya= !File(m.Dosyad)

Endif

This.Dosyad=m.Dosyad

m.Sayfad=Chrtran(Evl(This.Sayfad,"X"),"/&%#","*")

 

With oExcel As "Excel.Application"

  .Visible = .T.

 

  If m.yenidosya

    .Workbooks.Add

  Else

 

    ek = 0

    For ix = 1 To .ActiveWorkbook.Worksheets.Count

      If Alltrim(Upper(.ActiveWorkbook.Sheets[m.xi].Name))=Alltrim(Upper(m.Sayfad))

        ek = m.ek + 1

      Endif

    Endfor

    m.SayfaAd = Trim(m.SayfaAd + ' ' + Replicate('I', m.ek))

 

    .Workbooks.Open(m.Dosyad)

    .ActiveWorkbook.Sheets.Add

  Endif

 

  .ActiveWorkbook.ActiveSheet.Name = m.Sayfad

Endwith