1 Son düzenleyen, mrduyar (12.10.2006 09:38:56)

Konu: Memo alanların Excel e aktarılması?

Öncelikle yeni sitede bu ilk mesajım.
Bu forum da emeği geçen herkeze tek tek teşekkür ediyorum.


Sorum;

Memo alanlı bir table ı excel e nasıl aktarırım.

Visual Fox Pro
dosyaadi = Sys(2023)+ "\" + Sys(3)

    Select sonuc
    Export To &dosyaadi Type Xl5
    oExcel = Createobject('Excel.Application')
    oExcel.Workbooks.Open(dosyaadi)
    oExcel.Visible = .T.


bu kod ile memo alanlar boş geliyor.

1 memo alanlarda en fazla 1000 karakter var bilginiz olsun.

Yardımlarınız için şimdiden teşekkürler.

Bilmediğin Neyse Yanıldığındır.

2

Re: Memo alanların Excel e aktarılması?

Tesekkurler elimizden gelen en iyisi yapmaya calistik ve daha gelistirmek istiyoruz forumu, en azında n MS belki Turkiye dede Fox a sahip cikanlarin oldugunu farkeder smile

işine yarayabilecek 2 tane örnek

Visual Fox Pro
CLOSE ALL

CLEAR ALL
 
lcFieldString = ''
lcMemo = ''
 
USE GETFILE('dbf', 'Select DBF') && Prompts for table to be used.
 
lnFieldCount = AFIELDS(laGetFields) && Builds array of fields from the
                                    && selected table.
 
*!* Prompt for Output file and use Low-Level functions
*!* to create it.
lcTextFile = FCREATE(GETFILE('txt', 'Select Text'))
 
*!* Starts scanning the table and converts the fields
*!* values according to their types **
SCAN
   WAIT WINDOW STR(RECNO()) + ' Of ' + STR(RECCOUNT()) NOWAIT
 
   FOR lnCount = 1 TO lnFieldCount
      lcType = laGetFields(lnCount, 2)
 
      IF lcType # 'G' && Don't try to turn a general field into a string
         lcString = EVALUATE(laGetFields(lnCount, 1))
      EndIf
 
      DO CASE
         CASE lcType = 'M' && Process the Memo Fields
            lnMemoLines = MEMLINES(EVALUATE(laGetFields(lnCount,1)))
            FOR lnLoop = 1 TO lnMemoLines
               IF lnLoop < lnMemoLines
                  lcMemo = lcMemo + ;
                     ALLTRIM(MLINE(EVALUATE(laGetFields(lnCount, 1)), ;
                                   lnLoop)) + ' '
               ELSE
                  lcMemo = lcMemo + ;
                     ALLTRIM(MLINE(EVALUATE(laGetFields(lnCount, 1)), ;
                                   lnLoop))
               ENDif
            ENDfor
 
            lcString = lcMemo
            lcMemo = ''
         CASE lcType = 'G' && Process the General Fields
            lcString = 'Gen'
         CASE lcType = 'D' && Process the Date Fields
            lcString = DTOC(lcString)
         CASE lcType = 'T' && Process the DateTime Fields
            lcString = TTOC(lcString)
         CASE lcType = 'N' && Process the Numeric Fields
            lcString = STR(lcString, LEN(STR(lcString)), 2)
         CASE lcType = 'I' && Process the Integer Fields
            lcString = STR(lcString)
         CASE lcType = 'L' && Process the Logical Fields
            IF lcString = .T.
               lcString = 'T'
            ELSE
               lcString = 'F'
            ENDif
      ENDcase
 
      IF lnCount < lnFieldCount && Determines if the last field was
                                && processed and sets the closing quote.
         lcFieldString = lcFieldString + '"' + lcString + '"' + ','
      ELSE
         lcFieldString = lcFieldString + '"' + lcString + '"'
      ENDif
   ENDfor
 
   FPUTS(lcTextFile, lcFieldString) && Writes string to the text file.
   lcFieldString = ''
ENDscan
 
FCLOSE(lcTextFile)
 
CLOSE All
CLEAR All
WAIT WINDOW 'Text File Creation Completed' NOWAIT

2. cisi

* Kaynak Cetin BAŞÖZ

Visual Fox Pro
*Not : xlconstants.h (Excel header file) yoksa Excel'i ac, Alt+f11, f2 oject browseri getiriyor. Oradan asagida kullanilan excel sabitlerini bulup degerlerini yerine koyabilirsin (xl ile baslayanlar).

 
Use memotable
 
=Table2ClipBoard()
#include "excel-all.h"
oExcel = createobject("Excel.Application")
With oExcel
   .Workbooks.Add
   .visible = .t.
   With .ActiveWorkbook.ActiveSheet
      .Paste
      .Range('A1').CurrentRegion.Replace("PMARK",""+chr(10)+"",xlPart,xlByRows, .F.)
   Endwith
   With .Selection
      .ColumnWidth = 50 && Increase width for memo
      .HorizontalAlignment = xlGeneral
*      .VerticalAlignment = xlTop
      .WrapText = .T.
   Endwith
Endwith
 
 
Function Table2ClipBoard
lcTempFileName = "X"+sys(2015)+".tmp"
handle = fcreate(lcTempFileName)   && Create a temp file
#Define TABULATE chr(9)
#Define NL chr(13)
 
For ix = 1 to fcount()
   =fwrite(handle, field(ix))
   If ix < fcount()
      =fwrite(handle, TABULATE)
   Endif
Endfor
=fwrite(handle, NL)
Scan      && Start scan..endscan
   For ix = 1 to fcount()   && Write field values
      =fwrite(handle, typeconvert(ix) )
      If ix < fcount()
         =fwrite(handle, TABULATE)
      Endif
   Endfor
   =fwrite(handle, NL)
Endscan
lnSize=fseek(handle,0,2)
=fseek(handle,0,0)
_Cliptext = fread(handle, lnSize)  && Read file to clipboard
=fclose(handle)
Erase (lcTempFileName)
 
Function typeconvert
Lparameters tnField
lcType = type(field(ix))
If lcType = "G"
   lcField = field(ix)
*   Return '' && VFP5 and 3
   Return transform(&lcField) && VFP6 and up
Endif
luValue = eval(field(ix))
Do case
Case lcType = "D"
   lcValue = dtoc(luValue)
Case lcType = "T"
   lcValue = ttoc(luValue)
Case lcType $ "NY"
   lcValue = padl(luValue,20," ")
Case lcType = "L"
   lcValue = iif(luValue,"Yes","No")
Case lcType $ "M" && Replace paragraph marks with "PMARK"
   lcValue = strtran(luValue, chr(13)+chr(10), "PMARK")
Case lcType $ "C"
   lcValue = luValue
Otherwise
   lcValue = ""
Endcase
Return alltrim(lcValue)
http://www.soykansoft.com/images/twitter.jpghttp://www.soykansoft.com/images/wp.jpg

3

Re: Memo alanların Excel e aktarılması?

FoxyClasses - ExcelLib Dbf2Excel.ViaADO

Ramazan,
Yalniz oncelikle degisen Excel versiyonlarina ve VFPOLEDB'ye gore degisiklik gerekiyor (o yazildigi zaman VFPOLEDB yoktu).

Degisenler (benim gibi D:\Foxyclasses folderi kullaniyorsan):

MODIFY CLASS dbf2excel OF d:\foxyclasses\classes\excellib

*ViaADO method

Visual Fox Pro
With oConnection

*!*    .Provider = "MSDataShape"
*!*    .ConnectionString = [Provider=MSDataShape.1;Persist Security Info=False;]+;
*!*        [Data Source="Data Provider = MSDASQL;]+;
*!*        [DSN=Visual FoxPro Database;UID=;SourceDB=]+this.DBCPath+[;]+;
*!*    [SourceType=DBC;Exclusive=No;BackgroundFetch=Yes;Collate=Machine;Null=Yes;]+;
*!*            [Deleted=Yes;";Data Provider=MSDASQL ]
    .ConnectionString = [Provider=VFPOLEDB;Data Source=]+this.DBCPath
    .Open
Endwith

Visual Fox Pro
*!*With .QueryTables.Add(oRs, .Range("A1")) && Add recordset to sheet

*!*            .BackgroundQuery = .T.
*!*            .AdjustColumnWidth = .T.
*!*            .Refresh(.F.)
*!*        Endwith
        .Range('A1').CopyFromRecordSet( oRS )
        oRS.Close()

*loadRset method

Visual Fox Pro
*    .Source = [ SHAPE {]+tcSelect+[} ]

    .Source = m.tcSelect

Test kodu:
LOCAL loExporter as "dbf2excel" OF "d:\foxyclasses\classes\excellib.vcx"
loExporter = NEWOBJECT("dbf2excel","d:\foxyclasses\classes\excellib.vcx")
loExporter.DBCpath = _samples+'Data\testdata.dbc'
loExporter.ViaADO("FoxyExportedThis","employee")

4

Re: Memo alanların Excel e aktarılması?

Teşekkürler.
Bu arada başlığı yanlış yazmışım.
Düzeltebilirseniz memnun olurum.

Bilmediğin Neyse Yanıldığındır.

5

Re: Memo alanların Excel e aktarılması?

Düzelttim

http://www.soykansoft.com/images/twitter.jpghttp://www.soykansoft.com/images/wp.jpg