Показать сообщение отдельно
Старый 24.11.2004, 10:23   #2  
tron is offline
tron
Участник
 
6 / 10 (1) +
Регистрация: 24.11.2004
Адрес: Томск
Red face
Кому импортить проект неохота вот основные части простым текстом:
Таким образом формируется файл из 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>