tag:blogger.com,1999:blog-59465307047421309702024-03-06T16:20:07.273+08:00Jax 的工作紀錄除了在整理學習上的經驗,同時也能幫助其他需要的人Jax Huhttp://www.blogger.com/profile/01953021685585893658noreply@blogger.comBlogger3125tag:blogger.com,1999:blog-5946530704742130970.post-84746172627638706452018-04-16T11:08:00.001+08:002023-02-25T21:27:50.232+08:00[VBA] Read Write UTF-8 File<pre class="vb" name="code">Dim reader As Object
Set reader = CreateObject("ADODB.Stream")
reader.CharSet = "UTF-8"
reader.LineSeparator = 10
reader.Open
reader.LoadFromFile "C:\test.txt"
Dim textLine As String
Do Until reader.EOS
textLine = reader.ReadText(-2)
Loop
reader.Close
</pre><br />
<br />
<pre class="vb" name="code">Dim writer As Object
Set writer = CreateObject("ADODB.Stream")
writer.CharSet = "UTF-8"
writer.Open
writer.WriteText "xxxxxxx" & Chr(10)
writer.SaveToFile "C:\test.txt", 2
writer.Close
</pre>Jax Huhttp://www.blogger.com/profile/01953021685585893658noreply@blogger.com1tag:blogger.com,1999:blog-5946530704742130970.post-68670367813807309992012-02-01T15:18:00.000+08:002013-06-10T22:41:24.658+08:00[VBA] Office Excel 2003 連接 Web Service參考來源:<a target="_blank" href="http://mypaper.pchome.com.tw/stockfuture/post/1311885194">Excel 透過 VBA 呼叫 Web Service</a><br />
<br />
首先需要加入 Soap Library <br />
在『Visual Basic編輯器』中:工具 -> 設定引用項目 -> 勾選『Microsoft Office Soap Type Library v3.0』<br />
<br />
<pre class="vb" name="code">'連接 EpgSoap
Set EpgSoap = New SoapClient30
EpgSoap.MSSoapInit ("http://webservices.daehosting.com/services/isbnservice.wso?WSDL")
'請求 EpgSoap
MsgBox EpgSoap.IsValidISBN10("986-7889-18-5")
'關閉 EpgSoap
Set EpgSoap = Nothing
</pre>Jax Huhttp://www.blogger.com/profile/01953021685585893658noreply@blogger.com0tag:blogger.com,1999:blog-5946530704742130970.post-72477509176391494952012-01-24T18:58:00.008+08:002012-01-24T20:27:32.638+08:00[轉載] EXCEL 巨集與VBA介紹轉載自:<a href="http://web.ntit.edu.tw/~yclin/excel_new/excel06.htm">EXCEL 巨集與VBA介紹</a><br />
<br />
巨集:一連串的執行指令所構成,可以利用Visual Basic程式指令、也可以利用錄製巨集的方式來錄寫指令。<br />
<br />
<strong>如何錄製巨集:</strong><br />
<ol><li>如果要執行巨集,則需要更改「EXCEL選項」\「信任中心」\「信任中心設定」\「巨集設定」 </li>
<li>在「檢視」、「巨集」/「錄製巨集」</li>
<li>設定「巨集名稱」、快速鍵(Ctrl+英文鍵),將巨集儲存位置</li>
<li>開始錄製相關動作(錄製是以絕對位址方式來錄製,如果要以相對位址來錄製則要選「以相對位置錄製」)</li>
<li>停止錄製</li>
<li>查看巨集程式碼,並作必要的修正</li>
<li>執行巨集(可以利用「執行巨集」或快速鍵、或利用表單按鈕來執行),如果要編修表單時,可以按下Ctrl+該物件,進行修改。</li>
</ol><br />
<br />
<hr /><strong>範例:(錄製巨集)</strong><br />
<ol><li>C6至C12的數值格式設定「"進貨" #,##0;"出貨" #,##0」</li>
<li>「檢視」、「巨集」、「開始錄製」,並開始執行下列指令</li>
<li>選取範圍C6至C12,並執行「複製」</li>
<li>選取範圍B6至B12,並按下「選擇性貼上」,選擇貼上「值」與運算「加」</li>
<li>選取範圍C6至C12,並按下「Del」,清除儲存格內容</li>
<li>在儲存格C6按一下</li>
<li>停止錄製巨集</li>
<li>在工作表中,產生一個按鈕,並指定該按鈕執行該巨集,並將其按鈕文字改為異動</li>
<li>每次輸入異動資料(正的表示進貨,負的表示出貨),按下按鈕即可執行巨集</li>
</ol><br />
<br />
<hr /><strong>VBA簡介:</strong><br />
Visual Basic for Applications,利用VB來延申Office的能力。開啟EXCEL 顯示開發人員(在「EXCEL選項」/「常用」中勾選),再撰寫或修改VBA程式。<br />
<br />
VBA主要的組成要件:物件,其中包括<br />
<ol><li>屬性:對物件狀態的描述,可以定義物件的特性(大小、顏色、狀態等)。</li>
<li>方法:物件的某些特定動作,可以指定動作的細別內容。其主要結構如下:<br />
</code>物件.方法 指定引數1:=xl常數1, 指定引數2:=xl常數2,....</code><br />
<br />
指定引數設定為某些內建常數,每個內建常數前會有前綴字連接。<br />
<ul><li>EXCEL物件的常數會以xl開始。</li>
<li>VB的陳述式及函數的常數會以vb開始。</li>
<li>Office物件模式的常數會以mso開始。</li>
</ul></li>
<li>事件:物件的觸發反應。</li>
</ol><br />
<br />
<hr /><strong>EXCEL常用的物件</strong><br />
<ol><li><code>Workbook</code> 活頁簿</li>
<li><code>Workbooks</code> 活頁簿集合</li>
<li><code>Workbooks("filename")</code> 檔名為filename的活頁簿</li>
<li><code>ActiveWorkbook</code> 正在作用中的活頁簿</li>
<li><code>Sheets</code> 活頁簿中所有工作表</li>
<li><code>Sheets(n)</code> 活頁簿中第n張工作表</li>
<li><code>Worksheet</code> 工作表</li>
<li><code>Worksheets</code> 所有工作表(包括圖表)</li>
<li><code>Worksheets("sheet")</code> 指表名為sheet工作表</li>
<li><code>ActiveSheet</code> 正在作用中的工作表</li>
<li><code>Columns("c1:c2")</code> c1至c2欄(其中c1,c2為A~Z或AA~XFD等欄名)</li>
<li><code>Rows("r1:r2")</code> r1至r2列(其中r1,r2為1~1048576等列名</li>
<li><code>Range("x1:x2")</code> x1至x2間的儲存格(其中x1,x2為儲存格位址名稱)</li>
<li><code>cells(i,j)</code> 儲存格(第i列、第j行)</li>
<li><code>ActiveCell</code> 目前的儲存格</li>
<li><code>Selection</code> 目前所選取的物件</li>
</ol>範例:<pre class="vb:nogutter:nocontrols" name="code">Workbooks("Book1").Sheets("Sheet1").Range("A1:D5").Font.Bold = True
Worksheets("Sheet1").Cells.ClearContents
Worksheets("Sheet1").Rows(1).Font.Bold = True
Range("1:1,3:3,8:8")
Worksheets("Sheet1").Cells(6, 1).Value = 10
Worksheets("Sheet1").[A1:B5].ClearContents
ActiveCell.Offset(1, 3).Font.Underline = xlDouble
</pre><br />
<br />
<hr /><strong>活頁簿常用屬性:</strong><br />
<ul><li><code>ActiveWorkBook.Name</code> 目前活頁簿的名稱</li>
<li><code>ActiveWorkBook.Save</code> 儲存目前的活頁簿</li>
<li><code>ActiveWorkBook.SaveAs Filename := "filename"</code> 另儲新檔</li>
<li><code>WorkBooks.Add</code> 新增活頁簿</li>
<li><code>WorkBooks(i).Close [SaveChange, Filename, RouteWorkbook]</code> 關閉指定的第i個活頁簿 <br />
<ul><li><code>SaveChange</code> := True 改變儲存</li>
<li><code>SaveChange</code> := False 不會改變儲存</li>
<li><code>SaveChange</code> 省略時,會出現對話方塊</li>
<li><code>filename</code> := "檔名"</li>
</ul></li>
<li><code>WorkBooks.Open "filename"</code> 開啟一個活頁簿</li>
<li><code>Application.Windows</code> 所有活頁簿視窗</li>
<li><code>WorkBooks.Count</code> 活頁簿的數量</li>
<li><code>WorkBooks.Item(Index)</code> 傳回單一活頁簿,由索引值指定</li>
</ul><br />
<br />
<hr /><strong>工作表常用屬性:</strong><br />
<ul><li><code>Worksheets.Add [Before, After, Count, Type]</code> 新增工作表<br />
<ul><li><code>Before</code> := Worksheets(n) 出現於某工作表之前</li>
<li><code>After</code> := Worksheets(n) 出現於某工作表之後</li>
<li><code>Count</code> := n 新增工作表數量</li>
<li><code>Type</code> := xlWorksheet (工作表) 或 xlChart (圖表)</li>
</ul></li>
<li><code>WorkSheets.Name</code> 工作表名稱</li>
<li><code>WorkSheets("Sheet1").Activate</code> 設定工作表為目前作用的功作表</li>
</ul><br />
<br />
<hr /><strong>儲存格常用屬性:</strong><br />
<ul><li><code>Rows.RowHeight</code> 指定範圍內的所有列高</li>
<li><code>Columns.ColumnsWidth</code>:指定範圍內的所欄寬</li>
<li><code>expression.NumberFormatLocal</code> 以本地的數字格式</li>
<li><code>Range.CurrentRegion</code> 目前區域是指以任意空白列及空白欄的組合為邊界的範圍<br />
範例:<pre class="vb:nogutter:nocontrols" name="code">Worksheets("Sheet1").Activate
ActiveCell.CurrentRegion.Select
</pre></li>
<li><code>expression.Address(RowAbsolute, ColumnAbsolute, ReferenceStyle, External, RelativeTo)</code> 以參照的方式<br />
<ul><li><code>RowAbsolute</code> 為True,則用列的絕對位址</li>
<li><code>ColumnAbsolute</code> 為True,則用欄的絕對位址</li>
<li><code>ReferenceStyle</code> 預設值為xlA1,如為xlR1C1則為R1C1的表達方式</li>
</ul></li>
<li><code>expression.count</code> 傳回範圍的數量(可以是欄數、列數或儲存格數量)</li>
<li><code>expression.Item(RowIndex, ColumnIndex)</code> 代表相對於指定之範圍某個位移距離的範圍。</li>
<li><code>expression.value</code> 傳回或設定物件的值</li>
<li><code>expression.Formula</code> 傳回或設定物件的公式,代表 A1 樣式註解以及巨集語言中的物件公式。<br />
範例:<code>Worksheets("Sheet1").Range("A1").Formula = "=$A$4+$A$10"</code><br />
</li>
<li><code>expression.FormulaR1C1</code> 傳回或設定物件的公式,並以巨集語言中的 R1C1 樣式標記法表示<br />
範例:<code>Worksheets("Sheet1").Range("B1").FormulaR1C1 = "=SQRT(R1C1)"</code><br />
</li>
<li><code>expression.Text</code> 傳回或設定物件的文字<br />
範例:<pre class="vb:nogutter:nocontrols" name="code">Set c = Worksheets("Sheet1").Range("B14")
c.Value = 1198.3
c.NumberFormat = "$#,##0_);($#,##0)"
MsgBox c.Value
MsgBox c.Text
</pre></li>
</ul><br />
<br />
<hr /><strong> 常用方法:</strong><br />
<ul><li><code>Range.Select</code>方法/<code>Selection</code>屬性 設定目前選取的範圍/使用目前所選取的範圍<br />
範例:<pre class="vb:nogutter:nocontrols" name="code">Sub Macro1()
Sheets("Sheet1").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Address"
Range("A1:B1").Select
Selection.Font.Bold = True
End Sub
</pre></li>
<li><code>expression.Copy</code> 將目前所選取的物件復製至剪貼簿</li>
<li><code>expression.Cut</code> 將目前所選取的物件剪下</li>
<li><code>expression.Delete</code> 將目前所選取的物件刪除</li>
<li><code>expression.Paste</code> 將剪貼簿的內容貼上<br />
範例:<pre class="vb:nogutter:nocontrols" name="code">Sub CopyRow()
Worksheets("Sheet1").Rows(1).Copy
Worksheets("Sheet2").Select
Worksheets("Sheet2").Rows(1).Select
Worksheets("Sheet2").Paste
End Sub
</pre></li>
<li><code>expression.RasteSpecial(Paste,Operation, SkipBlanks, Transpose)</code><br />
範例:<pre class="vb:nogutter:nocontrols" name="code">With Worksheets("Sheet1")
.Range("C1:C5").Copy
.Range("D1:D5").PasteSpecial _
Operation:=xlPasteSpecialOperationAdd
End With
</pre></li>
<li><code>Range.Activate</code> 目前的儲存格</li>
<li><code>Range.Clear</code> 清除資料</li>
<li><code>Range.ClearContents</code> 清除資料內容</li>
<li><code>Range.ClearFormats</code> 清除資料格式</li>
<li><code>Range.ClearComments</code> 清除註解</li>
<li><code>expression.AutoFit</code> 自動調整列高和欄寬</li>
<li><code>Range.FillDown、Range.FillUp、Range.FillLeft、Range.FillRight</code> 填滿</li>
<li><code>Range.Offset(RowOffset, ColumnOffset)</code> 指定區域的位移列與行<br />
範例:<pre class="vb:nogutter:nocontrols" name="code">Sub MoveActive()
Worksheets("Sheet1").Activate
Range("A1:D10").Select
ActiveCell.Value = "Monthly Totals"
ActiveCell.Offset(0, 1).Activate
End Sub
</pre></li>
</ul><br />
<br />
<hr /><strong>程式語法:</strong><br />
<ul><li><br />
<dl><dt>Dim 陳述式(變數)</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">Dim varname [ As [New] type]
type 包括 Byte、Boolean、Integer、Long、Single、Double、Date、String、Object等</pre></dd>
<dt>Set 陳述式(物件)</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">Set objectvar = {[New] objectexpression | Nothing}
例:Set RangeA = Range("A1:B2")</pre>範例:<pre class="vb:nogutter:nocontrols" name="code">Sub Random()
Dim myRange As Range
Set myRange = Worksheets("Sheet1").Range("A1:D5")
myRange.Formula = "=RAND()"
myRange.Font.Bold = True
End Sub
</pre></dd>
<dt>With 多種屬性設定</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">With 物件
.屬性1 = 設定值
.屬性2 = 設定值
....
End With</pre>範例:<pre class="vb:nogutter:nocontrols" name="code">Sub AddNew()
Set NewBook = Workbooks.Add
With NewBook
.Title = "All Sales"
.Subject = "Sales"
.SaveAs Filename:="Allsales.xls"
End With
End Sub
</pre></dd>
<dt>Array 陣列</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">Array(Range1, Range2, ....)</pre>範例:<pre class="vb:nogutter:nocontrols" name="code">Sub Several()
Worksheets(Array("Sheet1", "Sheet2", "Sheet4")).Select
End Sub
</pre></dd>
<dt>InputBox 函數</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">InputBox("文字說明",[,title][,default][,xpos][,ypos][,helpfile, context])</pre></dd>
<dt>MsgBox 函數</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">MsgBox "文字說明"</pre></dd>
<dt>Union 將多個範圍合併成單一Range物件</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">Union(Range1, Range2, ...)</pre>範例:<pre class="vb:nogutter:nocontrols" name="code">Sub MultipleRange()
Dim r1, r2, myMultipleRange As Range
Set r1 = Sheets("Sheet1").Range("A1:B2")
Set r2 = Sheets("Sheet1").Range("C3:D4")
Set myMultipleRange = Union(r1, r2)
myMultipleRange.Font.Bold = True
End Sub
</pre></dd>
<dt>For... Next 陳述式</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">For counter = start to end [ step stepvalue]
[statements]
[Exit For]
[statements]
Next [counter]</pre>範例:<pre class="vb:nogutter:nocontrols" name="code">Sub CycleThrough()
Dim Counter As Integer
For Counter = 1 To 20
Worksheets("Sheet1").Cells(Counter, 3).Value = Counter
Next Counter
End Sub
</pre></dd>
<dt>For Each... Next 陳述式</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">For Each element In group
[statements]
[Exit For]
[statements]
Next [element]</pre>範例:<pre class="vb:nogutter:nocontrols" name="code">Sub ApplyColor()
Const Limit As Integer = 25
For Each c In Range("MyRange")
If c.Value > Limit Then
c.Interior.ColorIndex = 27
End If
Next c
End Sub
</pre></dd>
<dt>Do ... Loop 陳述式</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">Do [{While | Until} condition]
[statements]
[Exit Do]
[statements]
Loop</pre>或</dd><dd><pre class="vb:nogutter:nocontrols" name="code">Do
[statements]
[Exit Do]
[statements]
Loop [{While | Until} condition]</pre></dd>
<dt>If ... Then ... Else ... 陳述式</dt>
<dd><pre class="vb:nogutter:nocontrols" name="code">If condition Then [statements][Else elsestatements]</pre>或
<pre class="vb:nogutter:nocontrols" name="code">If condition Then
[statements]
[ElseIf condition-n Then
[elseifstatements]...
[Else
[elsestatements]]
End If</pre></dd></dl></li><br />
</ul><br />
<br />
<hr /><strong>範例:(VBA程式範例)</strong><br />
<pre class="vb" name="code">Sub pmt_title()
Dim rate As Single
Dim nper, i As Integer
Dim pv, totali, totalp As Double
Dim start As Date
Dim color1 As Variant
start = Range("C2").Value
pv = Range("C3").Value
rate = Range("C4").Value
nper = Range("C6").Value
'清除所有有明細表
Range("A11:E65536").Clear
With Cells(11, 1)
.Value = 0
.HorizontalAlignment = xlCenter
.Interior.Color = RGB(255, 255, 255)
End With
With Cells(11, 2)
.Value = start
.HorizontalAlignment = xlCenter
.NumberFormat = "ge年mm月dd日"
End With
Cells(11, 5) = pv
pv1 = pv
For i = 1 To nper
If i Mod 2 = 1 Then
color1 = RGB(255, 255, 150)
Else
color1 = RGB(255, 255, 255)
End If
With Cells(11 + i, 1)
.Value = i
.HorizontalAlignment = xlCenter
.Interior.Color = color1
End With
With Cells(11 + i, 2)
.Value = DateAdd("m", i, start)
.HorizontalAlignment = xlCenter
.Interior.Color = color1
.NumberFormatLocal = "ge年mm月dd日"
End With
With Cells(11 + i, 3)
.Value = -IPmt(rate / 12, i, nper, pv)
.Interior.Color = color1
.NumberFormat = "_-$* #,##0.00_-"
End With
totali = totali + Cells(11 + i, 3)
With Cells(11 + i, 4)
.Value = -PPmt(rate / 12, i, nper, pv)
.Interior.Color = color1
.NumberFormat = "_-$* #,##0.00_-"
End With
totalp = totalp + Cells(11 + i, 4)
With Cells(11 + i, 5)
.Value = pv - totalp
.Interior.Color = color1
.NumberFormat = "_-$* #,##0.00_-"
End With
Next i
With Range(Cells(10, 1), Cells(11 + nper, 5)).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.Color = RGB(0, 0, 0)
End With
Cells(12 + nper, 1) = "合計"
With Range(Cells(12 + nper, 1), Cells(12 + nper, 2))
.MergeCells = True
.HorizontalAlignment = xlCenter
.Interior.Color = RGB(255, 200, 255)
End With
With Cells(12 + nper, 3)
.Value = totali
.Interior.Color = RGB(255, 200, 255)
.NumberFormat = "_-$* #,##0.00_-"
End With
With Cells(12 + nper, 4)
.Value = totalp
.Interior.Color = RGB(255, 200, 255)
.NumberFormat = "_-$* #,##0.00_-"
End With
With Range(Cells(12 + nper, 1), Cells(12 + nper, 4)).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.Color = RGB(0, 0, 0)
End With
End Sub
'===================================================================
Sub clearall()
Range("A11:E65536").Clear
End Sub
</pre>Jax Huhttp://www.blogger.com/profile/01953021685585893658noreply@blogger.com1