none
Help with VBA code in Excel 2007 (VSTO 2005) RRS feed

  • Question

  • I wonder if somebody can take a look and ideally rewrite the marked areas of the code below. At best it behaves very unstable if used within an Excel Add-in, mostly it fails.


    Sub Writeback(pcell As PivotCell, newval As Double)
    
    
    
    
    
    
    
    Dim adocmd As New adodb.Command
    
    Dim adocon As New adodb.Connection
    
    Dim pt As PivotTable
    
    Dim pcache As PivotCache
    
    
    
    
    
    Set pt = pcell.Parent
    
    
    
    Dim pf As PivotField
    
    Dim pitmlist(2) As PivotItemList
    
    
    
    Set pcache = pt.PivotCache
    
    
    Dim
    cmdtxt As String Dim itmtxt As String Dim oldcf As String Dim cubnam As String Dim i As Integer 'Make sure Excel's connection is active If Not pcache.IsConnected Then pcache.MakeConnection End If 'Get Excel session command object and also get handle to connection object Set adocmd.ActiveConnection = pcache.ADOConnection adocmd.ActiveConnection.BeginTrans 'In cmdtxt we will build up command to send to AS 2000 to perform allocation cmdtxt = "" cmdtxt = cmdtxt & pcell.DataField.Name & "," 'Add each page field to cmdtxt If pt.PageFields.Count > 0 Then '
    ' HERE!
    '

    For
    Each pf In pt.PageFields cmdtxt = cmdtxt & pf.CurrentPageName & "," Next pf End If Set pitmlist(1) = pcell.RowItems Set pitmlist(2) = pcell.ColumnItems Dim k As Integer For k = 1 To 2 If pitmlist(k).Count > 0 Then 'Add row fields to cmdtxt, if any in view 'itmtxt is temporary text holder. Only add lowest level of each dimension in view to cmdtxt itmtxt = "" oldcf = pitmlist(k)(1).Parent.CubeField.Name 'itmtxt = "" 'This loop only adds to cmdtxt when CubeField changes For i = 1 To pitmlist(k).Count If pitmlist(k)(i).Parent.CubeField.Name = oldcf Then '
    'HERE!
    '

    itmtxt = pitmlist(k)(i) Else cmdtxt = cmdtxt & itmtxt & "," oldcf = pitmlist(k)(i).Parent.CubeField.Name itmtxt = pitmlist(k)(i) End If Next i 'Last rowitem is always lowest level and so added to cmdtxt '
    'HERE
    ' ' itmtxt = pitmlist(k)(pitmlist(k).Count)
    '
    ' how can this be re-written so the compiler does not complain about the missing cast. ' itmtxt = pitmlist(k)(pitmlist(k).Count) cmdtxt = cmdtxt & itmtxt & "," End If Next k cubnam = "[" & pcache.CommandText & "]" 'Could be modified to use other AS 2000 allocation algorithms cmdtxt = "Update cube " & cubnam & " set (" & _ VBA.Left(cmdtxt, Len(cmdtxt) - 1) & ")=" & newval & " Use_Equal_increment" adocmd.CommandText = cmdtxt adocmd.CommandType = adodb.adCmdUnknown adocmd.Execute 'Transaction can be commited if desired and cube is read/write for user adocmd.ActiveConnection.CommitTrans 'adocon.CommitTrans 'Need to refresh PivotTable to see effect of allocation in view pcache.Refresh End Sub

    Any help is appreciated.
    • Moved by Cindy Meister MVP Thursday, April 2, 2009 2:54 PM VBA question does not belong in the VSTO forum
    Thursday, April 2, 2009 11:41 AM

All replies

  • Looks like a repost....
    Thursday, April 2, 2009 1:18 PM
  • The VSTO forum is for questions that concern the VSTO technology. VBA code is not a topic. I believe I replied to and moved this same question from you earlier. Please do not post the question here again.

    I can imagine you've tried asking in various places, but quite frankly, you do not give any where near enough information about why your code is a problem. "It behaves very unstable" is not an accurate enough description for anyone to even begin to guess what the problem might be. Nor do you describe in any way how and why your VSTO project would be using this code.


    Cindy Meister, VSTO/Word MVP
    Thursday, April 2, 2009 2:53 PM
  • Thank you Cindy!

    I usually don't write this type of reply but since you where so kind to not even take a look at my question I make an exception. I come here to seek help and advice but your are wasting my time and yours by lecturing me.

    The code above is from an example created by Microsoft! I have tried to get it wot work because I was not able to find anything else that would do what I need to get done. I use the code in the context of VSTO and so I still think this forum will have people that can give me a hint.

    As for my question: I marked the area that creates trouble and listed the message I received

    --
    '
    'HERE
    '
    '    itmtxt = pitmlist(k)(pitmlist(k).Count)

    '
    '  how can this be re-written so the compiler does not complain about the missing cast.
    '
    --

    Be assured I will not post here anymore. As a matter of fact I will avoid any forum that is run by you! I rather find people that understand the meaning of MVP .....

    D


    Monday, April 6, 2009 2:54 PM