Нужно сохранить данные из таблицы Excel (xls, xlsx) в xml формате
Данные на листе могут быть целыми числами, числами с двумя знаками после запятой, текстовыми либо пустой ячейкой.
Название xml-тэга хранится в первом ряду колонки, данные начинаются с третьего.
Целую и дробную часть числа с двумя знаками после запятой нужно разделять точкой.
Нулевые значения в некоторых колонках нужно сохранять, а в некоторых - заменять тэгом со свойством
Итак, алгоритм:
- сканируем первую колонку, чтобы узнать кол-во строк с данными
- создаем файл в папке xls-файла с именем текущего файла+расширение xml
- сканируем каждый столбец и выгружаем данные в файл в соответствии с требованием о наличии/отсутствии нулевых значений
- суммируем данные в нужных колонках и выгружаем их в файл
Среда программирования - VBA (Visual Basic for Application) MS Office 2003.
ЗЫ: если кто еще не понял по тэгам - это выгрузка в таблицу 6 додатка 4 (в редакции 511 наказу), начало и конец xml-файла берем из сгенерированного EDZV или "кабинетом платника" файла, скомпонованный файл подсовываем сгенерировавшей его программе - профит.
ЗЗЫ: а жадюги СОТА и СОНАТА все равно ничего от нас не получат.
Данные на листе могут быть целыми числами, числами с двумя знаками после запятой, текстовыми либо пустой ячейкой.
Название xml-тэга хранится в первом ряду колонки, данные начинаются с третьего.
Целую и дробную часть числа с двумя знаками после запятой нужно разделять точкой.
Нулевые значения в некоторых колонках нужно сохранять, а в некоторых - заменять тэгом со свойством
xsi:nil="true"
.Итак, алгоритм:
- сканируем первую колонку, чтобы узнать кол-во строк с данными
- создаем файл в папке xls-файла с именем текущего файла+расширение xml
- сканируем каждый столбец и выгружаем данные в файл в соответствии с требованием о наличии/отсутствии нулевых значений
- суммируем данные в нужных колонках и выгружаем их в файл
Среда программирования - VBA (Visual Basic for Application) MS Office 2003.
ЗЫ: если кто еще не понял по тэгам - это выгрузка в таблицу 6 додатка 4 (в редакции 511 наказу), начало и конец xml-файла берем из сгенерированного EDZV или "кабинетом платника" файла, скомпонованный файл подсовываем сгенерировавшей его программе - профит.
ЗЗЫ: а жадюги СОТА и СОНАТА все равно ничего от нас не получат.
Dim StartRow, MaxRowCnt As Integer
Public Sub CommandButton1_Click()
Dim FileName As String
Dim i As Integer
StartRow = 3
MaxRowCnt = 1
For i = 1 To 1000
If ActiveSheet.Range("C" + Trim(Str(i + StartRow))).Value = 0 Then 'ãðîìàäÿíèí
MaxRowCnt = i
Exit For
End If
Next i
FileName = ActiveWorkbook.Path + "\" + ActiveWorkbook.Name + ".xml"
Open FileName For Output As #1
For i = 1 To MaxRowCnt
Print #1, GenOutStr("C", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("D", i, True)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("E", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("F", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("G", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("H", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("I", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("J", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("K", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("L", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("M", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("N", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("O", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("P", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStrDec("Q", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStrDec("R", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStrDec("S", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStrDec("T", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStrDec("U", i)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("V", i, True)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("W", i, True)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("X", i, True)
Next i
For i = 1 To MaxRowCnt
Print #1, GenOutStr("Y", i, True)
Next i
Print #1, GenOutSum("Q", "R01G17")
Print #1, GenOutSum("R", "R01G18")
Print #1, GenOutSum("T", "R01G19")
Print #1, GenOutSum("S", "R01G20")
Print #1, GenOutSum("U", "R01G21")
Close #1
End Sub
Public Function StrDec(SDRange As String) As String
StrDec = Format(ActiveSheet.Range(SDRange).Value, "0") + "." + Format((ActiveSheet.Range(SDRange).Value - Int(ActiveSheet.Range(SDRange).Value)) * 100, "00") 'êîñòûëè âû ìîè êîñòûëè
End Function
Public Function StrDec2(ByVal SDFloat As Single) As String
StrDec2 = Format(SDFloat, "0") + "." + Format((SDFloat - Int(SDFloat)) * 100, "00") 'âîò áû Frac ñäåëàòü...
End Function
Public Function GenOutStr(GOSCol As String, GOSRowNum As Integer, Optional ByVal NeedZeroVal As Boolean = False) As String
GOSString = "<" + Trim(ActiveSheet.Range(GOSCol + "1").Value) + " ROWNUM=""" + Trim(Str(GOSRowNum)) + """"
GOSValue = ActiveSheet.Range(GOSCol + Trim(Str(GOSRowNum + StartRow - 1))).Value
If GOSValue = "" Then GOSValue = 0
If (Not NeedZeroVal) And (GOSValue = 0) Then
GOSString = GOSString + " xsi:nil=""true"" />"
Else
GOSString = GOSString + ">" + Trim(CStr(GOSValue)) + "</" + Trim(ActiveSheet.Range(GOSCol + "1").Value) + ">"
End If
GenOutStr = GOSString
End Function
Public Function GenOutStrDec(GOSCol As String, GOSRowNum As Integer, Optional ByVal NeedZeroVal As Boolean = False) As String
GOSString = "<" + Trim(ActiveSheet.Range(GOSCol + "1").Value) + " ROWNUM=""" + Trim(Str(GOSRowNum)) + """"
GOSValue = ActiveSheet.Range(GOSCol + Trim(Str(GOSRowNum + StartRow - 1))).Value
If GOSValue = "" Then GOSValue = 0
If (Not NeedZeroVal) And (GOSValue = 0) Then
GOSString = GOSString + " xsi:nil=""true"" />"
Else
GOSString = GOSString + ">" + StrDec(GOSCol + Trim(Str(GOSRowNum + StartRow - 1))) + "</" + Trim(ActiveSheet.Range(GOSCol + "1").Value) + ">"
End If
GenOutStrDec = GOSString
End Function
Public Function GenOutSum(ByVal GOSCol As String, ByVal GOSTag As String) As String
Dim j As Integer
GOSSum = 0
For j = 1 To MaxRowCnt
GOSValue = ActiveSheet.Range(GOSCol + Trim(Str(j + StartRow - 1))).Value
If GOSValue = "" Then GOSValue = 0
GOSSum = GOSSum + GOSValue
Next j
GenOutSum = "<" + Trim(GOSTag) + ">" + StrDec2(GOSSum) + "</" + Trim(GOSTag) + ">"
End Function
Комментарии
Отправить комментарий