(SOFT) SOFT (2011 год)

ExcelPrice Converter - скачка и преобразование документов Excel в нужный формат за три клика мышкой.

Мне довольно часто приходится выполнять всякие преобразования документов EXCEL. Первые фрагменты различных преобразований на VBA на моем сайте сделаны в 2002-м году, хотя я начал работать на VBA еще в 1994 году.

Различные преобразования прайс-листов приходится делать постоянно - например в 2005-2007 я работал в крупнейшей российской системой электронных магазинов digitalshop.ru. Там было много-много проблем, которые надо было решать, но самая массивная задача там была конвертация множества разнообразных прайс-листов различных поставщиков в единый формат. Задача собственно отображения уже уложенных в базу данных была вторична - это могли сделать любые web-мастера (каждый на своей Web-технологии). И на этой базе товаров были сделаны десятки и десятки электронных магазинов.

При работе в режиме фриланса конвертация разнообразных прайс-листов в единый формат (например для последующей загрузки в базу) - это тоже самая распространенная задачка.

И вот через 15 лет работы на VBA я решил опубликовать эту простую обвязку, которая позволяет в ТРИ КЛИКА МЫШКОЙ выполнить всю работу по преобразованию документов Excel . А при необходимости войти в плагин на VBA и поправить код конвертации.

Прога публикуется именно в том виде - с которого она гнется в любую необходимую вам сторону наиболее легким способом. Я не стал обременять этот код функциями, которые возможно вам будут не нужны и которые будет трудно понять.

1. Небольшая (и в общем в данной простейшей проге не особо нужная) обвязка для обращений к Экселу.


   1:  Imports System.Globalization
   2:   
   3:  Public Class MSExcel
   4:   
   5:      Private ExcelType As Type
   6:      Public ExcelApplication As Microsoft.Office.Interop.Excel.Application
   7:      Private oDocs As Microsoft.Office.Interop.Excel.Workbooks
   8:      Private oBook As Microsoft.Office.Interop.Excel.Workbook
   9:   
  10:      Public Sub New()
  11:          ExcelApplication = New Microsoft.Office.Interop.Excel.Application
  12:          'or late binding 
  13:          'ExcelType = Type.GetTypeFromProgID("Excel.Application")
  14:          'ExcelApplication = Activator.CreateInstance(ExcelType)
  15:          ExcelApplication.DisplayAlerts = False
  16:      End Sub
  17:   
  18:      Public Function Open(ByVal strFileName As String) As Microsoft.Office.Interop.Excel.Workbook
  19:          '1). Getting the WoorkBook collection [work Sheet collection]
  20:          oDocs = ExcelApplication.Workbooks
  21:          ExcelApplication.AutomationSecurity = Microsoft.Office.Core.MsoAutomationSecurity.msoAutomationSecurityLow
  22:          ExcelApplication.DisplayAlerts = False
  23:          'Open the first work sheet  
  24:          oBook = oDocs.Open(strFileName)
  25:          Return oBook
  26:       End Function
  27:   
  28:      Public Function RunMacros(ByVal strFileName As String, ByVal ProcName As String)
  29:          'add a source .BAS module 
  30:          Dim xlmodule As Microsoft.Vbe.Interop.VBComponent
  31:          xlmodule = oBook.VBProject.VBComponents.Add(1) 'vbext_ct_StdModule
  32:          Try
  33:              xlmodule.CodeModule.AddFromFile(strFileName)
  34:          Catch ex As System.Runtime.InteropServices.COMException
  35:              If ex.Message.StartsWith("Name conflicts") Then
  36:                  GoTo next1
  37:              End If
  38:          End Try
  39:  next1:  ExcelApplication.Run(ProcName)
  40:      End Function
  41:   
  42:      Public Sub Quit()
  43:          ExcelApplication.Quit()
  44:      End Sub
  45:   
  46:  End Class

2. Код формы.


   1:  Public Class Form1
   2:   
   3:      Public DownloadName As String
   4:      Public FullDownloadFileName As String
   5:      Dim XLS As MSExcel
   6:      Dim ConvertScriptFullName As String
   7:   
   8:      Private Sub Form1_ControlAdded(ByVal sender As Object, ByVal e As System.Windows.Forms.ControlEventArgs) Handles Me.ControlAdded
   9:          SaveButton1.Enabled = False
  10:          DownloadButton1.Enabled = True
  11:          ConvertButton1.Enabled = False
  12:          ConvertScriptFullName = IO.Path.Combine(My.Application.Info.DirectoryPath, "Convert.bas")
  13:      End Sub
  14:   
  15:      Private Sub DownloadButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DownloadButton1.Click
  16:          Try
  17:              Me.Cursor = Cursors.WaitCursor
  18:              Status1.Text = "Please wait. Downloading..."
  19:              SaveButton1.Enabled = False
  20:              DownloadButton1.Enabled = False
  21:              '
  22:              'запрос по HTTP
  23:              Dim PageRequest As System.Net.HttpWebRequest = CType(System.Net.WebRequest.Create(TextBox1.Text), System.Net.HttpWebRequest)
  24:              PageRequest.UserAgent = "Mozilla/5.0 (Windows; U; Windows NT 5.2; ru; rv:1.9.2.3) Gecko/20100401 Firefox/3.6.3 (.NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30; .NET CLR 3.0.04506.648; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)"
  25:              PageRequest.Headers.Add("Accept-Language", "ru,en-us;q=0.7,en;q=0.3")
  26:              PageRequest.Headers.Add("Accept-Charset", "windows-1251,utf-8;q=0.7,*;q=0.7")
  27:              'Отправлен запрос
  28:              Status1.Text = "Download.."
  29:              Dim PageResponse As System.Net.HttpWebResponse = PageRequest.GetResponse
  30:              'Получен ответ
  31:              Dim Reader As New System.IO.BinaryReader(PageResponse.GetResponseStream)
  32:              Dim Buf As Byte() = Reader.ReadBytes(10000000)
  33:              Reader.Close()
  34:              'Загружено в память
  35:              Status1.Text = "Download OK."
  36:              DownloadName = Guid.NewGuid().ToString & ".xls"
  37:              FullDownloadFileName = IO.Path.Combine(My.Application.Info.DirectoryPath, DownloadName)
  38:              My.Computer.FileSystem.WriteAllBytes(FullDownloadFileName, Buf, False)
  39:              '
  40:              Status1.Text = "Save " & DownloadName
  41:              DownloadButton1.Enabled = False
  42:              ConvertButton1.Enabled = True
  43:              SaveButton1.Enabled = False
  44:              Me.Cursor = Cursors.Arrow
  45:          Catch x As System.Exception
  46:              DownloadButton1.Enabled = True
  47:              Status1.Text = x.Message
  48:              Me.Cursor = Cursors.Arrow
  49:          End Try
  50:      End Sub
  51:   
  52:      Private Sub ConvertButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ConvertButton1.Click
  53:          Try
  54:              Me.Cursor = Cursors.WaitCursor
  55:              Status1.Text = "Please wait. Converting..."
  56:              ConvertButton1.Enabled = False
  57:              DownloadButton1.Enabled = False
  58:              SaveButton1.Enabled = False
  59:              XLS = New MSExcel
  60:              Dim ActiveBook As Microsoft.Office.Interop.Excel.Workbook = XLS.Open(FullDownloadFileName)
  61:              XLS.RunMacros(ConvertScriptFullName, "Start")
  62:              Status1.Text = "Convert OK"
  63:              ConvertButton1.Enabled = False
  64:              DownloadButton1.Enabled = False
  65:              SaveButton1.Enabled = True
  66:              Me.Cursor = Cursors.Arrow
  67:          Catch ex As Exception
  68:              Me.Cursor = Cursors.Arrow
  69:              ConvertButton1.Enabled = True
  70:              DownloadButton1.Enabled = True
  71:              Status1.Text = ex.Message
  72:          End Try
  73:      End Sub
  74:   
  75:      Private Sub SaveButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SaveButton1.Click
  76:          Try
  77:              ConvertButton1.Enabled = False
  78:              DownloadButton1.Enabled = False
  79:              SaveButton1.Enabled = False
  80:              '
  81:              SaveFileDialog1.Filter = "XLS|*.xls|XLSX|*.xlsx"
  82:              SaveFileDialog1.Title = "Save Excel File"
  83:              Dim Res1 As DialogResult = SaveFileDialog1.ShowDialog
  84:              If Res1 = DialogResult.OK Then
  85:                  If SaveFileDialog1.FileName <> "" Then
  86:                      If My.Computer.FileSystem.FileExists(SaveFileDialog1.FileName) Then
  87:                          My.Computer.FileSystem.DeleteFile(SaveFileDialog1.FileName)
  88:                      End If
  89:                      My.Computer.FileSystem.CopyFile(FullDownloadFileName.Replace(".", "_target."), SaveFileDialog1.FileName)
  90:                  End If
  91:              End If
  92:              '
  93:              Status1.Text = "Save " & SaveFileDialog1.FileName
  94:              ConvertButton1.Enabled = False
  95:              DownloadButton1.Enabled = True
  96:              SaveButton1.Enabled = False
  97:              '
  98:              XLS.Quit()
  99:          Catch ex As Exception
 100:              Status1.Text = ex.Message
 101:              DownloadButton1.Enabled = True
 102:          End Try
 103:      End Sub
 104:   
 105:      Private Sub EditButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles EditButton1.Click
 106:          Try
 107:              Dim StartInfo As New System.Diagnostics.ProcessStartInfo
 108:              StartInfo.FileName = "notepad.exe"
 109:              StartInfo.Arguments = ConvertScriptFullName
 110:              System.Diagnostics.Process.Start(StartInfo)
 111:          Catch ex As Exception
 112:              Status1.Text = ex.Message
 113:          End Try
 114:      End Sub
 115:   
 116:   
 117:  End Class

3. Разметка формы.


   1:  <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
   2:  Partial Class Form1
   3:      Inherits System.Windows.Forms.Form
   4:   
   5:      'Form overrides dispose to clean up the component list.
   6:      <System.Diagnostics.DebuggerNonUserCode()> _
   7:      Protected Overrides Sub Dispose(ByVal disposing As Boolean)
   8:          Try
   9:              If disposing AndAlso components IsNot Nothing Then
  10:                  components.Dispose()
  11:              End If
  12:          Finally
  13:              MyBase.Dispose(disposing)
  14:          End Try
  15:      End Sub
  16:   
  17:      'Required by the Windows Form Designer
  18:      Private components As System.ComponentModel.IContainer
  19:   
  20:      'NOTE: The following procedure is required by the Windows Form Designer
  21:      'It can be modified using the Windows Form Designer.  
  22:      'Do not modify it using the code editor.
  23:      <System.Diagnostics.DebuggerStepThrough()> _
  24:      Private Sub InitializeComponent()
  25:          Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(Form1))
  26:          Me.TextBox1 = New System.Windows.Forms.TextBox()
  27:          Me.DownloadButton1 = New System.Windows.Forms.Button()
  28:          Me.SaveFileDialog1 = New System.Windows.Forms.SaveFileDialog()
  29:          Me.StatusStrip1 = New System.Windows.Forms.StatusStrip()
  30:          Me.Status1 = New System.Windows.Forms.ToolStripStatusLabel()
  31:          Me.ConvertButton1 = New System.Windows.Forms.Button()
  32:          Me.SaveButton1 = New System.Windows.Forms.Button()
  33:          Me.EditButton1 = New System.Windows.Forms.Button()
  34:          Me.Label1 = New System.Windows.Forms.Label()
  35:          Me.Label2 = New System.Windows.Forms.Label()
  36:          Me.Label3 = New System.Windows.Forms.Label()
  37:          Me.StatusStrip1.SuspendLayout()
  38:          Me.SuspendLayout()
  39:          '
  40:          'TextBox1
  41:          '
  42:          Me.TextBox1.Location = New System.Drawing.Point(114, 12)
  43:          Me.TextBox1.Name = "TextBox1"
  44:          Me.TextBox1.Size = New System.Drawing.Size(221, 20)
  45:          Me.TextBox1.TabIndex = 10
  46:          Me.TextBox1.Text = "http://83.222.2.140/price/price_igrushka.xls"
  47:          '
  48:          'DownloadButton1
  49:          '
  50:          Me.DownloadButton1.BackgroundImageLayout = System.Windows.Forms.ImageLayout.None
  51:          Me.DownloadButton1.Location = New System.Drawing.Point(30, 12)
  52:          Me.DownloadButton1.Name = "DownloadButton1"
  53:          Me.DownloadButton1.Size = New System.Drawing.Size(86, 20)
  54:          Me.DownloadButton1.TabIndex = 0
  55:          Me.DownloadButton1.Text = "Get XLS Price"
  56:          Me.DownloadButton1.UseVisualStyleBackColor = True
  57:          '
  58:          'StatusStrip1
  59:          '
  60:          Me.StatusStrip1.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.Status1})
  61:          Me.StatusStrip1.Location = New System.Drawing.Point(0, 99)
  62:          Me.StatusStrip1.Name = "StatusStrip1"
  63:          Me.StatusStrip1.Size = New System.Drawing.Size(346, 22)
  64:          Me.StatusStrip1.TabIndex = 2
  65:          Me.StatusStrip1.Text = "StatusStrip1"
  66:          '
  67:          'Status1
  68:          '
  69:          Me.Status1.Name = "Status1"
  70:          Me.Status1.Size = New System.Drawing.Size(0, 17)
  71:          '
  72:          'ConvertButton1
  73:          '
  74:          Me.ConvertButton1.BackgroundImageLayout = System.Windows.Forms.ImageLayout.None
  75:          Me.ConvertButton1.Location = New System.Drawing.Point(30, 38)
  76:          Me.ConvertButton1.Name = "ConvertButton1"
  77:          Me.ConvertButton1.Size = New System.Drawing.Size(86, 20)
  78:          Me.ConvertButton1.TabIndex = 2
  79:          Me.ConvertButton1.Text = "Convert"
  80:          Me.ConvertButton1.UseVisualStyleBackColor = True
  81:          '
  82:          'SaveButton1
  83:          '
  84:          Me.SaveButton1.BackgroundImageLayout = System.Windows.Forms.ImageLayout.None
  85:          Me.SaveButton1.Location = New System.Drawing.Point(30, 64)
  86:          Me.SaveButton1.Name = "SaveButton1"
  87:          Me.SaveButton1.Size = New System.Drawing.Size(86, 20)
  88:          Me.SaveButton1.TabIndex = 3
  89:          Me.SaveButton1.Text = "Save result"
  90:          Me.SaveButton1.UseVisualStyleBackColor = True
  91:          '
  92:          'EditButton1
  93:          '
  94:          Me.EditButton1.BackgroundImageLayout = System.Windows.Forms.ImageLayout.None
  95:          Me.EditButton1.Location = New System.Drawing.Point(312, 38)
  96:          Me.EditButton1.Name = "EditButton1"
  97:          Me.EditButton1.Size = New System.Drawing.Size(23, 20)
  98:          Me.EditButton1.TabIndex = 7
  99:          Me.EditButton1.Text = "..."
 100:          Me.EditButton1.UseVisualStyleBackColor = True
 101:          '
 102:          'Label1
 103:          '
 104:          Me.Label1.AutoSize = True
 105:          Me.Label1.Location = New System.Drawing.Point(6, 16)
 106:          Me.Label1.Name = "Label1"
 107:          Me.Label1.Size = New System.Drawing.Size(16, 13)
 108:          Me.Label1.TabIndex = 8
 109:          Me.Label1.Text = "1."
 110:          '
 111:          'Label2
 112:          '
 113:          Me.Label2.AutoSize = True
 114:          Me.Label2.Location = New System.Drawing.Point(6, 41)
 115:          Me.Label2.Name = "Label2"
 116:          Me.Label2.Size = New System.Drawing.Size(16, 13)
 117:          Me.Label2.TabIndex = 9
 118:          Me.Label2.Text = "2."
 119:          '
 120:          'Label3
 121:          '
 122:          Me.Label3.AutoSize = True
 123:          Me.Label3.Location = New System.Drawing.Point(6, 68)
 124:          Me.Label3.Name = "Label3"
 125:          Me.Label3.Size = New System.Drawing.Size(16, 13)
 126:          Me.Label3.TabIndex = 10
 127:          Me.Label3.Text = "3."
 128:          '
 129:          'Form1
 130:          '
 131:          Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
 132:          Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
 133:          Me.ClientSize = New System.Drawing.Size(346, 121)
 134:          Me.Controls.Add(Me.Label3)
 135:          Me.Controls.Add(Me.Label2)
 136:          Me.Controls.Add(Me.Label1)
 137:          Me.Controls.Add(Me.EditButton1)
 138:          Me.Controls.Add(Me.SaveButton1)
 139:          Me.Controls.Add(Me.ConvertButton1)
 140:          Me.Controls.Add(Me.StatusStrip1)
 141:          Me.Controls.Add(Me.DownloadButton1)
 142:          Me.Controls.Add(Me.TextBox1)
 143:          Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
 144:          Me.MaximizeBox = False
 145:          Me.MinimizeBox = False
 146:          Me.Name = "Form1"
 147:          Me.Text = "Price converter"
 148:          Me.StatusStrip1.ResumeLayout(False)
 149:          Me.StatusStrip1.PerformLayout()
 150:          Me.ResumeLayout(False)
 151:          Me.PerformLayout()
 152:   
 153:      End Sub
 154:      Friend WithEvents TextBox1 As System.Windows.Forms.TextBox
 155:      Friend WithEvents DownloadButton1 As System.Windows.Forms.Button
 156:      Friend WithEvents SaveFileDialog1 As System.Windows.Forms.SaveFileDialog
 157:      Friend WithEvents StatusStrip1 As System.Windows.Forms.StatusStrip
 158:      Friend WithEvents Status1 As System.Windows.Forms.ToolStripStatusLabel
 159:      Friend WithEvents ConvertButton1 As System.Windows.Forms.Button
 160:      Friend WithEvents SaveButton1 As System.Windows.Forms.Button
 161:      Friend WithEvents EditButton1 As System.Windows.Forms.Button
 162:      Friend WithEvents Label1 As System.Windows.Forms.Label
 163:      Friend WithEvents Label2 As System.Windows.Forms.Label
 164:      Friend WithEvents Label3 As System.Windows.Forms.Label
 165:   
 166:  End Class

4. В качестве простейшего шаблонного кода в данном проекте лежит код VBA, который просто отрезает шапку и добавляет 5% к цене товара.


   1:  Attribute VB_Name = "Convert"
   2:  Sub Start()
   3:   
   4:  Dim SourceFileName As String, TargetFileName As String
   5:  SourceFileName = Workbooks(1).FullName
   6:  Set SourceSheet = Workbooks(1).ActiveSheet
   7:  '
   8:  Dim NewWorkBooks As Workbook
   9:  Set NewWorkBooks = Workbooks.Add
  10:  Set TargetSheet = NewWorkBooks.ActiveSheet
  11:  '
  12:  Dim i As Long, j As Long
  13:  For i = 19 To 20000
  14:      For j = 1 To 14
  15:      If j = 9 and IsNumeric(SourceSheet.Cells(i, j).Value) Then
  16:          TargetSheet.Cells(i - 18, j) = SourceSheet.Cells(i, j).Value * 1.05
  17:      Else
  18:          TargetSheet.Cells(i - 18, j) = SourceSheet.Cells(i, j)
  19:      End If
  20:      Next
  21:  Next
  22:  '
  23:  'MsgBox "End converting"
  24:  '
  25:  TargetFileName = Replace(SourceFileName, ".", "_target.")
  26:  NewWorkBooks.SaveAs (TargetFileName)
  27:  End Sub

Excel вообще штука капризная и может потребоваться адаптация моей проги для ваших условий. Например в классе MSExcel может потребоваться изменить культуру потока (чтобы удовлетворить лицензионным ограничениям):


   10:      Public Sub New()
   11:          ExcelApplication = New Microsoft.Office.Interop.Excel.Application
   12:          Dim oldCI As System.Globalization.CultureInfo = System.Threading.Thread.CurrentThread.CurrentCulture
   13:          System.Threading.Thread.CurrentThread.CurrentCulture = New System.Globalization.CultureInfo("en-US")

С 2010-м экселом моя прога работает если только устновить дополнительную глобальную галку в Excel и перезагрузиться после этого.



Comments ( )
<00>  <01>  <02>  <03>  <04>  <05>  <06>  <07>  <08>  <09>  <10>  <11>  <12>  <13>  <14>  <15>  <16>  <17>  <18>  <19>  <20>  <21>  <22>  <23
Link to this page: //www.vb-net.com/ExcelPriceConverter/index.htm
<SITEMAP>  <MVC>  <ASP>  <NET>  <DATA>  <KIOSK>  <FLEX>  <SQL>  <NOTES>  <LINUX>  <MONO>  <FREEWARE>  <DOCS>  <ENG>  <CHAT ME>  <ABOUT ME>  < THANKS ME>