vba to create action row

Started by Bubba2413, June 10, 2012, 03:57:15 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Bubba2413

OK... so I'm a noob at this.

I'm trying to make a little sub that adds custom actions to selected shapes.  I can create a new row easily enough, but everytime I try to add the action, I keep getting failures...  What am I missing? 

Visio 2010, (but needs to work in 2003 and 2007)

I'm including a little test snippet.  I'm only putting the formula in avariable for ease of troubleshooting.
I've tried sTmp=""=""0""" to get a simple ="0" but even that isn't working.  Tried formula, formulaU, ForceFormula (and ..U)... CellsSRC, and CellsU.  Getting really frustrated.  I'm thinking the cell HAS to be a string, but maybe I'm wrong, or maybe I'm just not calling it correctly. Any Help would be appreciated.

dim sTmp
sTmp="""SETF(""Char.Color"",""rgb(0,0,255"")"""
With ActiveWindow.Selection(1)
  .AddNamedRow visSectionAction, "NewActionRow", 0
  .CellsSRC(visSectionAction, "NewActionRow", visActionAction).FormulaForceU = sTmp
End With

Bubba2413

hey!  got it!  (on my own even!  ;D
so apparently you HAVE to use an integer to id the row in CellsSRC.  ok.. so thats a pain, and you may not always know which row number actually contains  the value you want changed.  so.. I did a little modification...  (See Below)  Any thoughts on how I could do better?

Sub TestActionAdder()
    Dim sTmp As String
    'Const QT As String = chr(34) <--- fails???  why?
    Const QT As String = """"
    Const DQ As String = """"""
    sTmp = QT + "=This Is A Test" + QT
    'sTmp = "=This Is A Test"

    With ActiveWindow.Selection(1)
        'Retrieve Action Row number, Add action row if it does not exist
        If Not .CellExists("Actions.NewActionRow", 1) Then
            iTheRow = .AddNamedRow(visSectionAction, "NewActionRow", 0)
        Else
            iTheRow = .CellsRowIndex("Actions.NewActionRow")
        End If
       
        ' This updates the visible menu cell, Leave it blank if for 'internal' use
        ' only
        .Cells("Actions.NewActionRow").FormulaForceU = sTmp
       
        'Update the action cell (iTheRow MUST be an integer)
        .CellsSRC(visSectionAction, iTheRow, visActionAction).Formula = sTmp
   
        End With
End Sub

Jumpy

Instead of

.CellsSRC(visSectionAction, iTheRow, visActionAction).Formula = sTmp

you can use

.Cells("Actions.NewActionRow.Action")

so no need to preserve iTheRow.

Easy way to get the name of a cell is to reference it in another cell in the shapesheet.

------------

And you could create a small function to help with quoted strings:


Public Function QuoteMe(s as String) as String
  QuoteMe = CHR(34) & s & CHR(34)
End Function


and use it when you need it.

Bubba2413