Кому импортить проект неохота вот основные части простым текстом:
Таким образом формируется файл из 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 Ver. 1.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(CurrentString, 1) = "1") Then
FromRange = ReturnPart
ToRange = ReturnPart
Range(FromRange).Select
Selection.Copy
Range(ToRange).Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Rem InsertValue
ElseIf (Left(CurrentString, 1) = "2") Then
ToRange = ReturnPart
Value = ReturnPart
Worksheets(1).Range(ToRange).Value = Value
Rem DeleteRow
ElseIf (Left(CurrentString, 1) = "3") Then
ToRange = ReturnPart
CurrentRegion = ToRange + ":" + ToRange
Rows(CurrentRegion).Select
Selection.Delete Shift:=xlUp
Rem DeleteColumn
ElseIf (Left(CurrentString, 1) = "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(CurrentString, NowChar, 1) = ";") Then
Exit For
End If
ReturnPart = ReturnPart + Mid(CurrentString, NowChar, 1)
Next
NowChar = NowChar + 1
End Function