Advertisement
Tarlyun

Simple Export

Feb 13th, 2012
444
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub ExportTXT()
  2. '1. Начальная инициализация. Начало таблицы находится в ячейке А6
  3. 'A6 - caption таблицы
  4. 'A7+ - строки таблицы
  5. iFirstLine = 6
  6. iFirstCol = 1
  7. iLastLine = iFirstLine
  8. iLastCol = iFirstCol
  9. 'HTML классы для таблицы и четного ряда данных
  10. sTableClass = Cells(2, 2).Text
  11. sOddRowClass = Cells(3, 2).Text
  12.  
  13. 'Поиск ширины и высоты таблицы ведется по первому столбцу и первой строке таблицы после caption
  14. '2. Поиск высоты таблицы
  15. j = iFirstLine + 1
  16. Do While Cells(j, iFirstCol).Text <> ""
  17.     j = j + 1
  18. Loop
  19. iLastLine = j - 1
  20.  
  21. '3. Поиск Ширины таблиц
  22. j = iFirstCol
  23. Do While Cells(iFirstLine + 1, j).Text <> ""
  24.     j = j + 1
  25. Loop
  26. iLastCol = j - 1
  27.  
  28. '4. Начинаем таблицу
  29. sOutput = Cells(iFirstLine, iFirstCol).Text & vbNewLine
  30.  
  31. '5. Обрабатываем Excel таблицу
  32. For k = iFirstLine + 1 To iLastLine
  33.     sLine = ""
  34.     For j = iFirstCol To iLastCol
  35.         Set oCurrentCell = ActiveSheet.Cells(k, j)
  36.     sLine = sLine & oCurrentCell.Text
  37.     If j <> iLastCol Then
  38.         sLine = sLine & "|"
  39.     End If
  40.     Next j
  41.     sOutput = sOutput & sLine & vbNewLine
  42. Next k
  43.  
  44. '7. Выводим на экран полученный текст
  45. UserForm1.TextBox1.Text = sOutput
  46. UserForm1.Show
  47.  
  48. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement