Кому импортить проект неохота вот основные части простым текстом:
Таким образом формируется файл из Axapta 3.0
<div class='XPPtop'>X++</div><div class='XPP'>
[color=:green]// Tron 01.10.2004
[/color][color=:blue]void[/color] finalize()
{
TextBuffer textBuffer = [color=:blue]new[/color] TextBuffer();
;
[color=:green]// Добавляем тип файла
[/color] csvTextBuffer = [color=:red]"1;"[/color] + csvTextBuffer;
textBuffer.setText(csvTextBuffer);
textBuffer.toFile([color=:red]"c:\data.csv"[/color]);
this.dks_runMacro([color=:red]"Main"[/color]);
[color=:blue]super[/color]();
}</div>
А вот собственно макрос на Visual Basic:
<div class='XPPtop'>X++</div><div class='XPP'>
Rem Tron 01.10.2004
Rem Загрузка данных из внешних файлов [color=:green]// Axapta
[/color]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 = [color=:blue]False[/color]
Application.Visible = [color=:blue]False[/color]
Import
Sheets(1).Name = [color=:red]"Отчет"[/color]
Worksheets(1).Activate
Application.Visible = [color=:blue]True[/color]
Application.ScreenUpdating = [color=:blue]True[/color]
End Sub
Sub Import()
On Error GoTo ErrorHandler
Open [color=:red]"c:data.csv"[/color] [color=:blue]For[/color] Input Access Read As #1
Line Input #1, Variables
[color=:blue]Do[/color] [color=:blue]While[/color] [color=:blue]Not[/color] EOF(1)
Line Input #1, CurrentString
FillWorkSheet
Loop
Close #1
Exit Sub
ErrorHandler:
Worksheets(1).Range([color=:red]"A1"[/color]).Value = [color=:red]"Произошла ошибка обмена данными"[/color]
Exit Sub
End Sub
Sub FillWorkSheet()
NowChar = 3
Worksheets(1).Activate
Rem Dks_copyBookMark
[color=:blue]If[/color] ([color=:blue]Left[/color](CurrentString, 1) = [color=:red]"1"[/color]) Then
FromRange = ReturnPart
ToRange = ReturnPart
Range(FromRange).[color=:blue]Select[/color]
Selection.Copy
Range(ToRange).[color=:blue]Select[/color]
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=[color=:blue]False[/color], Transpose:=[color=:blue]False[/color]
ActiveSheet.Paste
Rem InsertValue
ElseIf ([color=:blue]Left[/color](CurrentString, 1) = [color=:red]"2"[/color]) Then
ToRange = ReturnPart
Value = ReturnPart
Worksheets(1).Range(ToRange).Value = Value
Rem DeleteRow
ElseIf ([color=:blue]Left[/color](CurrentString, 1) = [color=:red]"3"[/color]) Then
ToRange = ReturnPart
CurrentRegion = ToRange + [color=:red]":"[/color] + ToRange
Rows(CurrentRegion).[color=:blue]Select[/color]
Selection.Delete Shift:=xlUp
Rem DeleteColumn
ElseIf ([color=:blue]Left[/color](CurrentString, 1) = [color=:red]"4"[/color]) Then
ToRange = ReturnPart
CurrentRegion = ToRange + [color=:red]":"[/color] + ToRange
Columns(CurrentRegion).[color=:blue]Select[/color]
Selection.Delete Shift:=xlToLeft
End [color=:blue]If[/color]
End Sub
Function ReturnPart() As String
ReturnPart = [color=:red]""[/color]
[color=:blue]For[/color] NowChar = NowChar To Len(CurrentString)
[color=:blue]If[/color] (Mid(CurrentString, NowChar, 1) = [color=:red]";"[/color]) Then
Exit [color=:blue]For[/color]
End [color=:blue]If[/color]
ReturnPart = ReturnPart + Mid(CurrentString, NowChar, 1)
[color=:blue]Next[/color]
NowChar = NowChar + 1
End Function</div>
|