以文本方式查看主题

-  金字塔客服中心 - 专业程序化交易软件提供商  (http://weistock.com/bbs/index.asp)
--  高级功能研发区  (http://weistock.com/bbs/list.asp?boardid=5)
----  持仓信息导出Excel并管理盈亏的代码，精华呀！  (http://weistock.com/bbs/dispbbs.asp?boardid=5&id=6795)
--  作者：guotx2010
--  发布时间：2011/6/8 16:04:22
--  持仓信息导出Excel并管理盈亏的代码，精华呀！

这个模块需要打开Excel文件holdhing.xlsx，请下载:

http://m1.mail.sina.com.cn/apps/netdisk/download.php?id=53749010fa1386e8191cbf6f39c9b367

 

安装说明：

1、在d:\\下建立一个目录GuZhi

2、将Holding.xlsx复制到D:\\Guzhi下

3、建立一个VBA模块，将下面的代码复制进去，保存。

4、运行了VBA之后，在工具菜单上的扩展项下有两个选择：1）启动持仓管理 2）终止持仓管理，要进行管理就选择1），不要管理就选择2）。

5、Excel文件中有一个模式：可选择：管理盈亏、显示盈亏，选择“显示盈亏”时，只实时显示持仓的盈亏情况，并不帮你平仓，选择“管理盈亏”时，将根据你的设置进行盈亏管理，如果你有一个品种不想进行管理，可以将止损点数、止盈点数、回撤点数、保本点数都设为0（0值不显示），如果不想使用移动止盈，可以单修改回撤点数为0，其他如此类推。

 

如果你想下载完整的东西，可以单击：

http://m1.mail.sina.com.cn/apps/netdisk/download.php?id=9750c4bbbd07723ef3f1cb815c140482

就不用自己建立模块了，但是1、2步还是得做的。第3步只要将这个压缩文件中的mdHold.bas导入到VBA模块中就行了。

 

 

 

 

[此贴子已经被作者于2011-6-8 16:13:32编辑过]
--  作者：guotx2010
--  发布时间：2011/6/8 16:06:09
--  

public objExcel,objWorkbook
public AccountCode,Code,Market
private CodeArr(6),MarketArr(6),HoldingCount
private Report(6)
private iRow,iTimeCount
private Multipliter,MinTick,ShortPercent,LongPercent

 \'\'\'\'\'\'\'\'\'\'菜单操作
Sub MENU_Show()
 Menu.AddMenu 0, 0, "启动持仓管理"
 Menu.AddMenu 1, 1, "终止持仓管理"
End Sub
 
Sub MENU_Command(Cmd)
 Select Case Cmd
 Case 0
  StartManage
 Case 1
  EndManage
 End Select
End Sub


Sub APPLICATION_VBAStart()
 iTimeCount=0
 iRow=4
 GetAccountCode      \'将当前登录的账号保存到变量
End Sub

Sub APPLICATION_Timer(ID)
 iTimeCount=iTimeCount+1
 GetAccountCode
 On error Resume Next
 WriteNewPrice
 application.PeekAndPump
End Sub

Sub StartManage()  \'启动
 GetAccountCode      \'将当前登录的账号保存到变量
 iRow=4
 OpenExcel
 Call Application.SetTimer(5,2000)
 GetAllHolding AccountCode
End Sub 

Sub EndManage   \'停止管理
 Application.KillTimer(5)
 Set objExcel=Nothing
End Sub

Sub WriteNewPrice()
 dim i,iHold,NewPrice
 
 i=4
 On error resume next
 objExcel.sheets(1).Range("TimeCount").Value = iTimeCount
 
 Do while objExcel.sheets(1).Cells(i,2).Value<>""
  Code=objExcel.sheets(1).Cells(i,2).Value
  Market=objExcel.sheets(1).Cells(i,23).Value
  
  Set Report1 = marketdata.GetReportData(Code,Market)
  NewPrice=Report1.NewPrice
  objExcel.sheets(1).Cells(i,19).Value = NewPrice
  If NewPrice>objExcel.sheets(1).Cells(i,20).Value then
   objExcel.sheets(1).Cells(i,20).Value=NewPrice
  End if
  If NewPrice<objExcel.sheets(1).Cells(i,21).Value then
   objExcel.sheets(1).Cells(i,21).Value=NewPrice
  End if
  
  \'application.MsgOut objExcel.sheets(1).Cells(i,2).Value
  iHold=Abs(objExcel.sheets(1).Cells(i,3).Value)  \'持仓手数
  
  If objExcel.sheets(1).Range("Mode").Value="管理盈亏" then
   \'多单
   If objExcel.sheets(1).Cells(i,3).Value>0 then
    If NewPrice<objExcel.sheets(1).Cells(i,10).Value And objExcel.sheets(1).Cells(i,9).Value>0 then
     \'止损
     WriteLog "买",NewPrice,"多单止损",i
     PingDuoDan 0,Code,Market,iHold
    End if
    If NewPrice>objExcel.sheets(1).Cells(i,12).Value And objExcel.sheets(1).Cells(i,11).Value>0 then
     \'止赢
     WriteLog "买",NewPrice,"多单止盈",i
     PingDuoDan 0,Code,Market,iHold
    End if
    If objExcel.sheets(1).Cells(i,13).Value>0 And NewPrice>objExcel.sheets(1).Cells(i,5).Value then \'回撤止赢
     If objExcel.sheets(1).Cells(i,20).Value-NewPrice>objExcel.sheets(1).Cells(i,13).Value then \'回撤点数大于设置数
      WriteLog "买",NewPrice,"多单回撤止盈",i
      PingDuoDan 0,Code,Market,iHold
     End if
    End if 
    If NewPrice<objExcel.sheets(1).Cells(i,16).Value And NewPrice>objExcel.sheets(1).Cells(i,5).Value _
    And objExcel.sheets(1).Cells(i,20).Value>objExcel.sheets(1).Cells(i,5).Value+2 And objExcel.sheets(1).Cells(i,15).Value>0 then
     \'保本:最高价大于保本价，最新价小于保本价，且有盈利
     WriteLog "买",NewPrice,"多单保本",i
     PingDuoDan 0,Code,Market,iHold
    End if
   End if \'End 多单
   \'空单
   If objExcel.sheets(1).Cells(i,3).Value<0 then
    If NewPrice>objExcel.sheets(1).Cells(i,10).Value And objExcel.sheets(1).Cells(i,9).Value>0 then
     \'止损
     WriteLog "卖",NewPrice,"空单止损",i
     PingKongDan 0,Code,Market,iHold
    End if
    If NewPrice<objExcel.sheets(1).Cells(i,12).Value And objExcel.sheets(1).Cells(i,11).Value>0 then
     \'止赢
     WriteLog "卖",NewPrice,"空单止盈",i
     PingKongDan 0,Code,Market,iHold
    End if
    If objExcel.sheets(1).Cells(i,13).Value>0 And NewPrice<objExcel.sheets(1).Cells(i,5).Value then \'回撤止赢
     If NewPrice-objExcel.sheets(1).Cells(i,21).Value>objExcel.sheets(1).Cells(i,13).Value then \'回撤点数大于设置数
      WriteLog "卖",NewPrice,"空单回撤止盈",i
      PingKongDan 0,Code,Market,iHold
     End if
    End if 
    
    If NewPrice<objExcel.sheets(1).Cells(i,5).Value-2 And NewPrice>objExcel.sheets(1).Cells(i,16).Value _
    And objExcel.sheets(1).Cells(i,20).Value>objExcel.sheets(1).Cells(i,16).Value And objExcel.sheets(1).Cells(i,15).Value>0 then
     \'保本
     WriteLog "卖",NewPrice,"空单保本",i
     PingKongDan 0,Code,Market,iHold
    End if
   End if  \'End 空单
  End if  \'End 管理盈亏 
  i=i+1
 Loop 
End Sub

\'写成交日志
Sub WriteLog(sAspect,nNewPrice,sMemo,iHoldRow)
 dim iLogRow  \'sheets(2)已使用行数
 iLogRow=objExcel.sheets(2).UsedRange.Rows.Count+1
 objExcel.sheets(2).Cells(iLogRow,1).Value=CDate(Time)
 objExcel.sheets(2).Cells(iLogRow,2).Value=objExcel.sheets(1).Cells(iHoldRow,2).Value
 objExcel.sheets(2).Cells(iLogRow,3).Value=sAspect
 if sAspect="买" then
  objExcel.sheets(2).Cells(iLogRow,4).Value=objExcel.sheets(1).Cells(iHoldRow,3).Value
  objExcel.sheets(2).Cells(iLogRow,5).Value=objExcel.sheets(1).Cells(iHoldRow,5).Value
  objExcel.sheets(2).Cells(iLogRow,9).Value=(nNewPrice-objExcel.sheets(1).Cells(iHoldRow,5).Value)*objExcel.sheets(1).Cells(iHoldRow,22).Value*objExcel.sheets(1).Cells(iHoldRow,3).Value
 else
  objExcel.sheets(2).Cells(iLogRow,4).Value=Abs(objExcel.sheets(1).Cells(iHoldRow,3).Value)
  objExcel.sheets(2).Cells(iLogRow,5).Value=objExcel.sheets(1).Cells(iHoldRow,5).Value
  objExcel.sheets(2).Cells(iLogRow,9).Value=(objExcel.sheets(1).Cells(iHoldRow,5).Value-nNewPrice)*objExcel.sheets(1).Cells(iHoldRow,22).Value*Abs(objExcel.sheets(1).Cells(iHoldRow,3).Value)
 end if 
 \'最高价、最低价
 objExcel.sheets(2).Cells(iLogRow,6).Value=objExcel.sheets(1).Cells(iHoldRow,20).Value
 objExcel.sheets(2).Cells(iLogRow,7).Value=objExcel.sheets(1).Cells(iHoldRow,21).Value
 objExcel.sheets(2).Cells(iLogRow,8).Value=nNewPrice
 objExcel.sheets(2).Cells(iLogRow,10).Value=sMemo
End Sub

Sub OpenExcel()
 On Error Resume Next
 Set objExcel = GetObject(,"Excel.Application")
 if Err.number<>0 then
  Set objExcel = CreateObject("Excel.Application")
  \'打开指定文件
  Set objExcel = GetObject("D:\\GuZhi\\Holding.xlsx")
 else
  \'打开指定文件
  Set objExcel = GetObject("D:\\GuZhi\\Holding.xlsx")
 end if 
 objExcel.Parent.Windows("Holding.xlsx").Activate
 objExcel.Application.DisplayFormulaBar=False
  objExcel.Application.Visible = True
End Sub
 
\'成交后重新取得持仓信息
Sub Order_OrderStatusEx2(OrderID, Status, Filled, Remaining, Price, Code, Market, OrderType, Aspect, Kaiping, Account, AccountType)
 If Status="Filled" then
  GetAllHolding AccountCode
 End if 
End Sub
\'未完，待续
--  作者：guotx2010
--  发布时间：2011/6/8 16:06:57
--  

\'这里的代码接着上面的，放在上面模块下方。

 Sub GetAllHolding(sAccount)
  dim i,k
  dim BuyHolding
 dim BuyCost
 dim BuyTodayHolding
 dim SellHolding
 dim SellCost
 dim SellTodayHolding
 dim PNL
 dim UseMargin
 dim Code
 dim Market

  On Error resume Next
    objExcel.Sheets(1).Unprotect
   
  objExcel.Sheets(1).Range("Mode")="显示盈亏"
  
  objExcel.Sheets(1).Range("B4:E9").ClearContents
   
    objExcel.Sheets(1).Range("S4:U9").ClearContents
   
  objExcel.Sheets(1).Rows("4:9").Select
    objExcel.Application.Selection.EntireRow.Hidden = False
      
  HoldingCount=Order.Holding2(sAccount)
  \'Application.MsgOut "HoldingCount:" & HoldingCount
  If HoldingCount>0 then
   For i=0 to HoldingCount-1
    Call Order.HoldingInfo2(i,BuyHolding,BuyCost,BuyTodayHolding,SellHolding,SellCost,SellTodayHolding,PNL,UseMargin,Code,Market,sAccount)
    CodeArr(i)=Code
    MarketArr(i)=Market
    GetContract Code,Market
    \'Call Order.HoldingInfoByCode2(Code,Market,BuyHolding,BuyCost,BuyTodayHolding,SellHolding,SellCost,SellTodayHolding,PNL,UseMargin,sAccount)
    
    objExcel.sheets(1).Cells(i+iRow,2).Value = Code
    If BuyHolding>0 then
     objExcel.sheets(1).Cells(i+iRow,3).Value = BuyHolding
     objExcel.sheets(1).Cells(i+iRow,4).Value = BuyTodayHolding
     If BuyHolding>0 then
      objExcel.sheets(1).Cells(i+iRow,5).Value = BuyCost/Multipliter/BuyHolding
     Else
      objExcel.sheets(1).Cells(i+iRow,5).Value = BuyCost
     End if 
     If objExcel.sheets(1).Cells(i+iRow,20)=0 then  \'如果最高价为0，将开仓价写入最高价
      objExcel.sheets(1).Cells(i+iRow,20)=objExcel.sheets(1).Cells(i+iRow,5)
      objExcel.sheets(1).Cells(i+iRow,21)=objExcel.sheets(1).Cells(i+iRow,5)
     End if 
    End if
 
    If SellHolding>0 then
     objExcel.sheets(1).Cells(i+iRow,3).Value = -SellHolding
     objExcel.sheets(1).Cells(i+iRow,4).Value = -SellTodayHolding
     If SellHolding>0 then
      objExcel.sheets(1).Cells(i+iRow,5).Value = SellCost/Multipliter/SellHolding
     Else
      objExcel.sheets(1).Cells(i+iRow,5).Value = SellCost
     End if 
     If objExcel.sheets(1).Cells(i+iRow,21)=0 then  \'如果最低价为0，将开仓价写入最低价
      objExcel.sheets(1).Cells(i+iRow,21)=objExcel.sheets(1).Cells(i+iRow,5)
      objExcel.sheets(1).Cells(i+iRow,20)=objExcel.sheets(1).Cells(i+iRow,5)
     End if
    End if 
    objExcel.sheets(1).Cells(i+iRow,22).Value = Multipliter
    objExcel.sheets(1).Cells(i+iRow,23).Value = Market
   Next \'End i
   \'设置数字微调按钮显隐
   For k=1 to HoldingCount
      objExcel.Sheets(1).Shapes("SpinZsds" & Cstr(k)).Visible = True
      objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Visible = True
      objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Visible = True
      objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Visible = True
      \'设置微调按钮的位置
      objExcel.Sheets(1).Shapes("spinZsDs" & Cstr(k)).Top = objExcel.Sheets(1).Range("J" & Cstr(k+iRow-1)).Top
      objExcel.Sheets(1).Shapes("spinZsDs" & Cstr(k)).Left = objExcel.Sheets(1).Range("J" & Cstr(k+iRow-1)).Left - objExcel.Sheets(1).Shapes("spinZsDs" & Cstr(k)).Width
      objExcel.Sheets(1).Shapes("spinZsDs" & Cstr(k)).Height = objExcel.Sheets(1).Range("J" & Cstr(k+iRow-1)).Height
      
      objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Top = objExcel.Sheets(1).Range("L" & Cstr(k+iRow-1)).Top
      objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Left = objExcel.Sheets(1).Range("L" & Cstr(k+iRow-1)).Left - objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Width
      objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Height = objExcel.Sheets(1).Range("L" & Cstr(k+iRow-1)).Height
      
      objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Top = objExcel.Sheets(1).Range("N" & Cstr(k+iRow-1)).Top
      objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Left = objExcel.Sheets(1).Range("N" & Cstr(k+iRow-1)).Left - objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Width
      objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Height = objExcel.Sheets(1).Range("N" & Cstr(k+iRow-1)).Height
      
      objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Top = objExcel.Sheets(1).Range("P" & Cstr(k+iRow-1)).Top
      objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Left = objExcel.Sheets(1).Range("P" & Cstr(k+iRow-1)).Left - objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Width
      objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Height = objExcel.Sheets(1).Range("P" & Cstr(k+iRow-1)).Height
     Next
   If HoldingCount<6 then
      For k=HoldingCount+1 to 6
       objExcel.Sheets(1).Shapes("SpinZsds" & Cstr(k)).Visible = False
       objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Visible = False
       objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Visible = False
       objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Visible = False
      Next
      objExcel.Sheets(1).Rows(HoldingCount+iRow & ":9").Select
      objExcel.Application.Selection.EntireRow.Hidden = True
     End if
    Else
     objExcel.Sheets(1).Range("S4:U9").Select
     objExcel.Application.Selection.ClearContents
     objExcel.Rows("5:9").Select
     objExcel.Application.Selection.EntireRow.Hidden = True
  End if
  objExcel.Sheets(1).Range("B4").Select
  objExcel.ActiveSheet.Protect
End Sub

Sub GetContract(sCode,sMarket)  \'获取合约的信息
 Call Order.Contract(sCode,sMarket,Multipliter,MinTick,ShortPercent,LongPercent)
End Sub

Sub GetAccountCode()        \'取得当前登录的帐号
    Dim sAccount            \'记录可能更换了的账号
    If AccountCode = "" Then
        AccountCode = CStr(Trim(ORDER.ACCOUNT(1)))
    End If
    sAccount = CStr(Trim(ORDER.ACCOUNT(1)))
    If sAccount = AccountCode Then
        Exit Sub
    Else
        AccountCode = sAccount
        GetAllHolding sAccount
    End If
End Sub

\'平多单
Sub PingDuoDan(nPrice,sCode,sMarket,iOrdVol)  \'平多单，nPrice=0时为市价，否则就是传递过来的价
 If iOrdVol>0 then
  If nPrice=0 then
   Call Order.Sell(1,iOrdVol,0,0,sCode,sMarket,"",0)    \'市价平多单
  Else
   Call Order.Sell(0,iOrdVol,nPrice,0,sCode,sMarket,"",0)   \'限价平多单
  End If 
 End If
End Sub
\'平空单
Sub PingKongDan(nPrice,sCode,sMarket,iOrdVol)  \'平空单，nPrice=0时为市价，否则就是传递过来的价
 If iOrdVol>0 then
  If nPrice=0 then
   Call Order.SellShort(1,iOrdVol,0,0,sCode,sMarket,"",0)    \'市价平空单
  Else
   Call Order.SellShort(0,iOrdVol,nPrice,0,sCode,sMarket,"",0)   \'限价平空单
  End If 
 End If
End Sub
--  作者：rogerhylt
--  发布时间：2011/10/22 11:51:59
--  
精华 这个牛
--  作者：sun884588
--  发布时间：2012/5/26 6:43:04
--  
很强大，很强大
--  作者：guotx2010
--  发布时间：2012/5/26 8:40:20
--  

现在金字塔支持股票自动交易了，我这个持仓管理功能可以做些修改成为股票持仓管理的哟。

 
--  作者：sun884588
--  发布时间：2012/6/5 17:10:12
--  
已经下载，还没用，慢慢学习，谢谢楼主
--  作者：爬山虎福气
--  发布时间：2017/11/15 21:41:36
--  
看得头大，模仿写了一个，错误不断