Показать сообщение отдельно
Старый 24.11.2004, 10:15   #2  
tron is offline
tron
Участник
 
6 / 10 (1) +
Регистрация: 24.11.2004
Адрес: Томск
Кому импортить проект неохота вот основные части простым текстом:
Таким образом формируется файл из Axapta 3.0
PHP код:
// Tron 01.10.2004
void finalize()
{
    
TextBuffer      textBuffer = new TextBuffer();
    ;
    
// Добавляем тип файла
    
csvTextBuffer "1;" csvTextBuffer;

    
textBuffer.setText(csvTextBuffer);
    
textBuffer.toFile("c:\\data.csv");

    
this.dks_runMacro("Main");
    
super();

А вот собственно макрос на Visual Basic:
PHP код:
Rem Tron 01.10.2004
Rem Загрузка данных из внешних файлов 
// Axapta
Rem Ver1.0.1.5

Dim CurrentString 
As String
Dim Variables 
As String
Dim I 
As Long
Dim NowChar 
As Long

Dim FromRange 
As String
Dim ToRange 
As String
Dim Value 
As String

Sub Main
()
    
Application.ScreenUpdating False
    Application
.Visible False
        
    Import
 
    Sheets
(1).Name "Отчет"
    
Worksheets(1).Activate
    Application
.Visible True
    Application
.ScreenUpdating True
End Sub

Sub Import
()
On Error GoTo ErrorHandler
        Open 
"c:\data.csv" For Input Access Read As #1
        
Line Input #1, Variables
    
        
Do While Not EOF(1)
            
Line Input #1, CurrentString
            
FillWorkSheet
        Loop
    
        Close 
#1
Exit Sub
ErrorHandler
:
    
Worksheets(1).Range("A1").Value "Произошла ошибка обмена данными"
Exit Sub
    
End Sub

Sub FillWorkSheet
()
    
NowChar 3
    Worksheets
(1).Activate
    
    Rem Dks_copyBookMark
    
If (Left(CurrentString1) = "1"Then
        FromRange 
ReturnPart
        ToRange 
ReturnPart
        Range
(FromRange).Select
        Selection
.Copy
        Range
(ToRange).Select
        Selection
.PasteSpecial Paste:=xlPasteColumnWidthsOperation:=xlNone_
            SkipBlanks
:=FalseTranspose:=False
        ActiveSheet
.Paste
    Rem InsertValue
    
ElseIf (Left(CurrentString1) = "2"Then
        ToRange 
ReturnPart
        Value 
ReturnPart
        Worksheets
(1).Range(ToRange).Value Value
    Rem DeleteRow
    
ElseIf (Left(CurrentString1) = "3"Then
        ToRange 
ReturnPart
        CurrentRegion 
ToRange ":" ToRange
        Rows
(CurrentRegion).Select
        Selection
.Delete Shift:=xlUp
    Rem DeleteColumn
    
ElseIf (Left(CurrentString1) = "4"Then
        ToRange 
ReturnPart
        CurrentRegion 
ToRange ":" ToRange
        Columns
(CurrentRegion).Select
        Selection
.Delete Shift:=xlToLeft
    End 
If
    
    
End Sub

Function ReturnPart() As String
    ReturnPart 
""
    
For NowChar NowChar To Len(CurrentString)
        If (
Mid(CurrentStringNowChar1) = ";"Then
            
Exit For
        
End If
        
ReturnPart ReturnPart Mid(CurrentStringNowChar1)
    
Next
    NowChar 
NowChar 1
End 
Function