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 (
)
)
Link to this page:
//www.vb-net.com/ExcelPriceConverter/index.htm
|
|