持仓信息导出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模块中就行了。

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
'未完，待续

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

 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