【Excel家庭记账-II】v2.4.4版 ★2013.1.28 更新

Ｚane.Ｙ

功能强大，测试完毕，

Delphima

Ｚane.Ｙ 发表于 2012-1-9 19:44
功能强大，测试完毕，

谢谢，其他方面也请多提意建。

高绪山

你好，请问与"中国银行"的汇率通讯程序在什么地方？

Delphima

高绪山 发表于 2012-1-10 01:12
你好，请问与"中国银行"的汇率通讯程序在什么地方？

刚才弄错了，这是2007全功能版的，需要带注释版的，请看说明书最后一页：

Private Sub CurrencyUpdate_Click()
EHF_05SysStg.[J18].Value = "正在导入网络数据..."

With TX_00ChtData.QueryTables.Add(Connection:="URL;http://www.boc.cn/sourcedb/whpj", Destination:=TX_00ChtData.Range("$K$1"))
.Name = "whpj"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "8"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
On Error GoTo InternetFaild
.Refresh BackgroundQuery:=False
End With

Dim i As Integer
With TX_00ChtData
For i = 2 To EHF_05SysStg.[C1048576].End(xlUp).Row
Select Case EHF_05SysStg.Cells(i, 3).Value
Case "人民币"
EHF_05SysStg.Cells(i, 4).Value = 1#
Case "美元"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("美元").Row, 17).Value / 100, 4)
Case "欧元"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("欧元").Row, 17).Value / 100, 4)
Case "英镑"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("英镑").Row, 17).Value / 100, 4)
Case "港币"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("港币").Row, 17).Value / 100, 4)
Case "澳元"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("澳大利亚元").Row, 17).Value / 100, 4)
Case "纽元"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("新西兰元").Row, 17).Value / 100, 4)
Case "加元"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("加拿大元").Row, 17).Value / 100, 4)
Case "日元"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("日元").Row, 17).Value / 100, 4)
Case "韩元"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("韩国元").Row, 17).Value / 100, 4)
Case "卢布"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("卢布").Row, 17).Value / 100, 4)
Case "澳门元"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("澳门元").Row, 17).Value / 100, 4)
Case "泰国铢"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("泰国铢").Row, 17).Value / 100, 4)
Case "新加坡元"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("新加坡元").Row, 17).Value / 100, 4)
Case "瑞士法郎"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("瑞士法郎").Row, 17).Value / 100, 4)
Case "瑞典克朗"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("瑞典克朗").Row, 17).Value / 100, 4)
Case "丹麦克朗"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("丹麦克朗").Row, 17).Value / 100, 4)
Case "挪威克朗"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("挪威克朗").Row, 17).Value / 100, 4)
Case "菲律宾比索"
EHF_05SysStg.Cells(i, 4).Value = Round(.Cells(.Range("K:K").Find("菲律宾比索").Row, 17).Value / 100, 4)
End Select
Next i
.Range("K:S").Delete
End With
EHF_05SysStg.[J18].Value = "在线数据导入成功..."
ActiveWorkbook.Connections(1).Delete
MsgBox "中国银行外汇牌价导入成功！", vbOKOnly, "提示"
EHF_05SysStg.[J18].Value = " 最后更新：" & Date
Exit Sub

InternetFaild:
Resume ErrorClear_02
ErrorClear_02:
ActiveWorkbook.Connections(1).Delete
Message = MsgBox("更新失败！可能的原因：" & Chr(10) & Chr(10) & _
"1. 网络连接失败请确认网络连接正常，并确保能够登陆中国银行主页；" & Chr(10) & Chr(10) & _
"2. 中国银行网页已失效，请到ExcelHome论坛查看更新办法。", vbExclamation, "错误")
EHF_05SysStg.[J18].Value = " 最近一次导入失败！"
End Sub

高绪山

Delphima 发表于 2012-1-10 17:27
刚才弄错了，这是2007全功能版的，需要带注释版的，请看说明书最后一页：

Private Sub CurrencyUpdate ...

TX_00ChtData 是什么对象？

Delphima

高绪山 发表于 2012-1-11 03:38
TX_00ChtData 是什么对象？

其中一个工作表的名称在VBA编辑器里能看到

解放区的天

学习了！学习了！

danysy

功能应该很强大了，支持

2011BB

哇塞，睇到眼花，可能太专业了，不知作何用，真系要好好学习！楼主好棒！{:soso_e183:}

GUANCHZH

学习了！学习了！