I'm developing an Excel Add-in using VSTO on vb.Net, where I'm struglling to get the names of the existing controls of a worksheet. In this project I'm adding two types of controls, a TableLayoutPanel and a NamedRange.
I loop the existing worksheet controls and I'm abble to get the type of the control, and in case of it be a NamedRange control I'm successfully getting its reference cell. Notwithstanding, I'm not able to get the name of both control types.
How can I get the name of the controls ?
The code bellow is where I'm creating the controls:
`Dim painel = New System.Windows.Forms.TableLayoutPanel
Dim changesRange As Microsoft.Office.Tools.Excel.NamedRange
Dim nomes As Microsoft.Office.Interop.Excel.Names = Globals.ThisAddIn.Application.ActiveWorkbook.Names
PanelsID += 1
changesRange = ws.Controls.AddNamedRange(range, CStr("NamedRange_" & PanelsID))
ws.Controls.AddControl(painel, range, "Panel" & PanelsID)
Dim name1 As Excel.Name = CType(changesRange.Name, Excel.Name)
'I could get the name of the control here
MessageBox.Show(name1.Name)`
The code bellow is where I'm looping the existing worksheet controls:
Function lerRange(ws As Microsoft.Office.Tools.Excel.Worksheet, range As Excel.Range) As Boolean
Dim wsControls As Integer
wsControls = ws.Controls.Count
For i = 0 To wsControls - 1
'Image1
MsgBox(ws.Controls(i).GetType.ToString)
If InStr(ws.Controls(i).GetType.ToString, "NamedRange") > 0 Then
'Image2
MsgBox(ws.Controls(i).RefersTo)
'Image3
MsgBox(ws.Controls(i).name.ToString)
Else
'Image4 - Using property name without toString()
MsgBox(ws.Controls(i).name)
End If
Next
lerRange = False
End Function
Output Image1 - Type of the control
Output Image2 - Refering range of the NamedRange control
Output Image3 - Output name of the control
Output Image4 - Error message
Thanks in advance to the ones who could help !
The Name property of NamedRange control has a capitel letter on the start and is an object. So you can try to get the name like this example.
...
For i = 0 To wsControls - 1
If InStr(ws.Controls(i).GetType.ToString, "NamedRange") > 0 Then
...
MsgBox(ws.Controls(i).Name.name)
...
End If
Next
...
More informations do you get at microsofts docs for NameRange.Name property.
Related
I´m trying to create a code in vba excel to detect what´s inside the work flow objects - 3D as the ones shown in the following picture:
The pictures are always the same. I have been able to find and select the sentence inside the cell. But I need it to search for all the work flow objects in different visio.
This is where I got to:
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
Dim vsoCharacters1 As Visio.Characters
Set vsoCharacters1 = Application.ActiveWindow.Page.Shapes.ItemFromID(228).Characters
Debug.Print vsoCharacters1
I need the code to first find all the work flow objects in different pages in visio and then obtain the sentence within (vsoCharacters1)
Please try this simple code
Sub ttt()
Dim doc As Document ' Variable for Document
Dim pg As Page ' Variable for Page
Dim shp As Shape ' Variable for Shape
Dim txt As String ' Variable for Shape's text
For Each doc In Documents ' Iterate all documents in Visio application session
For Each pg In doc.Pages ' Iterate all pages in 'doc'
For Each shp In pg.Shapes ' Iterate all docunents in 'pg'
txt = shp.Text ' Define 'txt' variable
Select Case txt ' Criterion
Case "ololo", "trololo" ' Found text
ActiveWindow.Page = pg ' Activate page with criterion
ActiveWindow.Select shp, visSelect ' Select shape with criterion
MsgBox "Page: " & pg.Name & ", ShapeID: " & shp.ID, , "A shape was found, the text of which matches the criterion: " & txt
End Select
ActiveWindow.DeselectAll ' Unselect a shape
Next shp
Next pg
Next doc
MsgBox "TheEnd!!!"
End Sub
Note:
This code started in MS Visio, code without recursion, dont find shapes into groups !
May I propose a more systematic approach?
Drawing explorer
Make sure you're in developer mode.
Switch the drawing explorer on.
Identify the shape to explore
Expand its tree to see its sub-shapes
If you're lucky a pro has made this shape and named the subshapes eg Label, Frame, what ever. This will simplify the access to this shape.
in VBA:
shp being your group shape object
access the sub-shape via: set subshp = shp.Shapes(name_of_subshape)
This works also for the sub-shapes of the sub-shape.
Otherwise - the sub-shapes are named sheet.234 - you need to find another identification method.
Open the shapesheet of the sub-shape (right-mouse-click)
Inspect it and try to figure out in how far it differs from the other sub-shapes. That can be a text, user or prop field, a geometry section ... etc.
in VBA you would then loop over all the sub-shapes and check for this property.
eg:
for each subshape in shp.Shapes:
if subshape.CellExists("soAndSo",0) then
if subshape.Cells("soAndso").ResultStr("") = "thisAndThat" then
'you found it, do your stuff.
By the way, you don't need to access the characters object of a shape to get its text. It is simply "shp.Text". The characters object is more complexe and lets you do funny stuff with the text.
I need combo boxes to be placed in specific positions in relation to the cells on this Worksheet. I was attempting to utilize a while loop to change a variables value and utilize that variable to dynamic change a cell. However, my code doesn't seem to be working. The loop will run through once, but will give me a "object does not support this property or method" error on the successive loop.
Dim t As Integer
Dim wotype as object
t = 1
Do While t < 43
wotype = ActiveSheet.Shapes.AddFormControl(xlDropDown, Left:=Cells(4, t).Left, Top:=Cells(3, t).Top, Width:=25.29, Height:=Rows(3).RowHeight)
t = t + 3
Loop
When assigning an object to a variable, you need to use the Set keyword...
set wotype = ActiveSheet.Shapes.AddFormControl(xlDropDown, Left:=Cells(4, t).Left, Top:=Cells(3, t).Top, Width:=25.29, Height:=Rows(3).RowHeight)
Although, in this case, since you're not subsequently referring to your variable, your code can be re-written as follows...
Dim t As Integer
t = 1
Do While t < 43
ActiveSheet.Shapes.AddFormControl xlDropDown, Left:=Cells(4, t).Left, Top:=Cells(3, t).Top, Width:=25.29, Height:=Rows(3).RowHeight
t = t + 3
Loop
After a Paste special linking of a range of cells from Excel to Word (2013) the field looks like this:
{ LINK Excel.SheetMacroEnabled.12 D:\\20181228\\SC.xlsm Sheet1!R10C1:R10C20" \a \p }
If you click on the object with the right button, select "Format object" and then click on "?", the Format AutoShape reference article opens.
However, ActiveDocument.Shapes.SelectAll does not detect this object.
This code also does not work, although the error message says that this component is available for pictures and OLE objects:
With ActiveDocument.Shapes(1).PictureFormat
.ColorType = msoPictureGrayScale
.CropBottom = 18
End With
What is this object?
I cannot find it in Object model (Word).
How to access it through VBA?
I want to programmatically resize a group of such objects to 90% of the original.
Upd. #Cindy Meister suggested where to dig, thanks.
I wrote the code, it seems to work fine:
Sub ResizeImages()
Dim img As Long
With ActiveDocument
For img = 1 To .InlineShapes.Count
With .InlineShapes(img)
.ScaleHeight = 90
.ScaleWidth = 90
End With
Next img
End With
End Sub
A Link field must be an InlineShape - it can't be a Shape, not if you can display the field using Alt+F9. Since Shape objects have text wrap formatting any field codes associated with them (usually none) aren't accessible.
Therefore, any object that's displayed via a Link field should be available via the InlineShape object model.
For example, the following code loops the fields in the document and, if they're link fields with an Excel source and contain an InlineShape, the InlineShape's dimensions are scaled:
Dim fld as Word.Field
For Each fld In ActiveDocument.Fields
If fld.Type = wdFieldLink
If fld.Result.InlineShapes.Count > 1 And _
InStr(fld.OLEFormat.ClassType, "Excel") Then
Set ils = fld.Result.InlineShapes(1)
ils.ScaleWidth = 90
ils.ScaleHeight = 90
End If
End If
Next
i am trying t assign the values of a named range to an array of variants. I get an application or object defined error almost at the level of assignment code
Material = ThisWorkbook.Names("RMInStoreName").RefersToRange
i got this example from here and have used it before sucessfully.
I am still trying to figure out why this error is showing up, i seem to have run out of ideas, anybody can help me point in the right direction will realy save me alot
The code is below
Here is the code
Sub MonitorStore()
Dim ThreshHold As Variant, InStore As Variant, StatusReport As Variant
Dim Material As Variant 'is the name of the material
Status As Variant
'status is a variable which holds data on wether the user has seen msg and
'wants to supress msg
'the ThreshHold is the minimum allowed in store below which messages are firerd
'InStore is the volume of materials currently in store
'and be told of another error after solving error one, report all at once
Material = ThisWorkbook.Names("RMInStoreName").RefersToRange
ThreshHold = ThisWorkbook.Names("RMThreshHold").RefersToRange
InStore = ThisWorkbook.Names("RMInStore").RefersToRange
Status = ThisWorkbook.Names("RMStatus").RefersToRange
'other code.............
'dont expect error from unexecuted code
End Sub
Thanks for help
Stephen
The most likely reason is that you don't have all of the named ranges defined in the workbook.
You can verify the named ranges using the Formula tab.
Formula --> Name Manager
RefersToRange will return a range object. Its the value you are after then:
Material = ThisWorkbook.Names("RMInStoreName").RefersToRange.Value
or you can use:
Material = Evaluate("RMInStoreName")
or:
Material = Evaluate(ThisWorkbook.Names("RMInStoreName").RefersTo).Value
If someone can help, I need some in properly defining some call parameters in an Access 2003 to Excel 2003 VBA problem. I'm trying to use the XIRR function in the ATP 2.0 Type Library from Access. I have referenced the ATP 2.0 Type Library in my Access project. Here is the relevant VBA code (with a little pseudocode) I'm using behind a form:
Dim aCF as Variant 'this variant will hold the cash flows
Dim aDates as Variant 'this variant will hold the dates
Dim oATP2 As ATP2.OCATP
Set oATP2 = New ATP2.OCATP 'used in the Form_Open event to instantiate the object
In this model I always have five cash flows to work with: prior quarter value as an outflow, three months of net collections and the current quarter terminal value. (If there were more elements involved, I would certainly use a loop structure.) In a user-defined sub I redim the variants, load the arrays and call XIRR:
GetAssetReturn_X()
REDIM aDates(4) 'base 0
aDates(0) = DateSerial(Year(wDBBaseDate), Month(wDBBaseDate) - 2, 1) - 1 'e.g. 3-31- 2010
aDates(1) = DateSerial(Year(wDBBaseDate), Month(wDBBaseDate) - 1, 1) - 1 'e.g. 4-30-2010
aDates(2) = DateSerial(Year(wDBBaseDate), Month(wDBBaseDate), 1) - 1 'e.g. 5-31-2010
aDates(3) = wDBBaseDate 'e.g. 6-30-2010
aDates(4) = wDBBaseDate 'e.g. 6-30-2010
REDIM aCF(4) 'base 0
'from a recordset...
aCF(0) = -rs.Fields(2) 'pprd cash flow
aCF(1) = rs.Fields(3) 'net collection cprd - 2
aCF(2) = rs.Fields(4) 'net collection cprd - 1
aCF(3) = rs.Fields(5) 'net collection cprd
aCF(4) = rs.Fields(6) 'cprd cash flow
GetAssetReturn_X = oATP2.XIRR(aCF, aDates)
End Sub
The autosense feature works; when I type "oATP2." and I get a list of available functions ater the dot. So I assume the object is, in fact, correctly instantiated. Maybe not. However, whenever I run the code, I get the infamous runtime error "91: Object variable or With block variable not set." For the life of me, I'm missing the structural problem here. So I am presently assuming that the calling parameters have not been correctly described. I read somewhere these have to be variants. Maybe these need to be arrays or maybe range objects. Thanks.
I added to your code Set oATP2 = New ATP2.OCATP but I get the 429 error. Did you finally could use ATP2 library? as an alternative solution this code run in MS access but It is too slow:
Function tasa1(A, B)
Set AnalysisApp = CreateObject("Excel.Application")
Set AnalysisWkb = AnalysisApp.Workbooks.Open("C:\Archivos de programa\Microsoft Office\OFFICE11\Macros\Análisis\atpvbaen.xla")
AnalysisWkb.RunAutoMacros xlAutoOpen
tasa1 = AnalysisApp.Application.Run(AnalysisWkb.Name & "!XIRR", A, B, 0.1) * 100
End Function