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
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.
My Excel macro reads the answers to a survey from a set of Excel files. The answers of a survey contain a score (from 1 to 4) and a description. The goal is to generate a a matrix. Each cell of the matrix has a color that represents the score. I would like the user to be able to modify the layout of these cell. To make it easy to the user, I created a template matrix and a button. The user should be able to modify the layout of the cells and on a click of a button, a set of styles (Score 1, Score 2,...) should be generated. Once the matrix is created, the Workbook should be to function without the survey files.
I have tried a couple of things:
Try 1
ThisWorkbook.Styles.Add "Score 1", BasedOn:=cell1
This gives errors. I don't fully understand when they occur, but one of the causes is when the user modifies the cell layout by selecting another style.
Try 2
ThisWorkbook.Styles("Score 1").Delete
ThisWorkbook.Styles.Add "Score 1", BasedOn:=cell1
This is not a good idea: all cells loose their styling when it is executed a second time.
Try 3: Current
Copy the most frequently used properties of the cells layout and copy them to the style. If this style is deleted by the user, it is recreated. This procedures is not ideal, since most style properties won't be covered.
Is there a way to update a cell style that is more general? I would like there to be as little room as possible to make the workbook in an inconsistent and non-functional state.
I sticked with try 3. Because it required a lot of code for all properties that seemed possible to be edited, and because of copying borders is tricky, I post the result.
'xR1_Template: the cell to base the style on
'nm_Style: the name of the style
Public Function Upsert_Style(xR1_Template As Excel.Range, nm_Style As String) As Excel.Style
Dim xStyle As Excel.Style
Set xStyle = Fn.TryGet(ThisWorkbook.Styles, nm_Style)
If Fn.IsNothing(xStyle) Then
Set xStyle = ThisWorkbook.Styles.Add(nm_Style)
End If
xStyle.Font.Color = xR1_Template.Font.Color
xStyle.Font.Bold = xR1_Template.Font.Bold
xStyle.Font.Name = xR1_Template.Font.Name
xStyle.Font.Italic = xR1_Template.Font.Italic
xStyle.Font.Size = xR1_Template.Font.Size
xStyle.Font.Strikethrough = xR1_Template.Font.Strikethrough
xStyle.Font.Subscript = xR1_Template.Font.Subscript
xStyle.Font.Superscript = xR1_Template.Font.Superscript
xStyle.Font.Underline = xR1_Template.Font.Underline
xStyle.Interior.Color = xR1_Template.Interior.Color
xStyle.Interior.Pattern = xR1_Template.Interior.Pattern
xStyle.Interior.PatternColor = xR1_Template.Interior.PatternColor
'NOTE: necessary to delete all borders first. There's no way to delete them one by one.
xStyle.Borders.LineStyle = xlNone
Dim iBorder As Long
For iBorder = 1 To xR1_Template.Borders.Count
Dim xBorder As Excel.Border
'NOTE: The Borders property claims to work with xlBordersIndex argument, but this is not true.
' Normal indexing is used.
Set xBorder = xR1_Template.Borders(iBorder)
'NOTE: "none-style" borders (=no border), should be skipped.
' Once they are retrieved using the Borders property, they are always visible.
' Setting them with xlLineStyle.xlLineStyleNone does not hide them.
If xBorder.LineStyle <> XlLineStyle.xlLineStyleNone Then
Dim xBorder_Style As Excel.Border
Set xBorder_Style = xStyle.Borders(iBorder)
xBorder_Style.Color = xBorder.Color
xBorder_Style.LineStyle = xBorder.LineStyle
xBorder_Style.Weight = xBorder.Weight
End If
Next iBorder
xStyle.AddIndent = xR1_Template.AddIndent
xStyle.FormulaHidden = xR1_Template.FormulaHidden
xStyle.HorizontalAlignment = xR1_Template.HorizontalAlignment
xStyle.IndentLevel = xR1_Template.IndentLevel
xStyle.NumberFormat = xR1_Template.NumberFormat
xStyle.NumberFormatLocal = xR1_Template.NumberFormatLocal
xStyle.Orientation = xR1_Template.Orientation
xStyle.ShrinkToFit = xR1_Template.ShrinkToFit
xStyle.VerticalAlignment = xR1_Template.VerticalAlignment
xStyle.WrapText = xR1_Template.WrapText
xStyle.IndentLevel = xR1_Template.IndentLevel
Set Upsert_Style = xStyle
End Function
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.
I have a macro that will append a page to the current document from a pre-formatted template. This page inserts a picture based off user selection, which they have the standard excel supported images(i.e. .jpg, .png, .bmp) as well as PDF's(taken off an AutoCAD program that can only save as PDF/DWG/DXF file types. The problem I'm having is that I cannot rotate landscape print formatted images the way that I can with the regular images. I know that the problem is likely that not all OLEobjects can be rotated and the shaperange option probably does not allow for rotation. That being said, is it possible to do this within VBA?
I have tried to use the OLEobject shaperange option, as well as inserting the PDF as a picture(which is not supported by MS-Office as far as I know). I have also tried to select the OLEobject as a shape to no avail.
Set rng = crrntWorkbook.Sheets(1).Range("B" & tempRow)
'Allows for the insertion of PDF files into the workbook
Set oleobj = ActiveSheet.OLEObjects.Add(Filename:=txtFileName, link:=False, DisplayAsIcon:=False)
With oleobj
'Inserts the picture into the correct cell
oleobj.Top = rng.Top
oleobj.Left = rng.Left
'If the image is wider than it's height, image will be scaled down by it's width, otherwise it's height
If oleobj.Width > oleobj.Height Then
oleobj.IncrementRotation = 90
oleobj.Width = 545
oleobj.Left = (570 - oleobj.Width) / 2
oleobj.Top = oleobj.Top + 2
'Centers the image
Else
oleobj.Height = 625
oleobj.Left = (550 - oleobj.Width) / 2
oleobj.Top = oleobj.Top + 2
End If
End With
The expected result is that the image will be rotated upon insertion, but I will get either a "runtime error '438' Object doesn't support this property or method" or a "runtime error -2147024809 the shape is locked and cannot be rotated if I use the shaperange approach"
Good Morning,
I’m hoping that some kind soul out there can help me with a roadblock I’ve encountered in my quest to manipulate a website with VBA. I am using MS Excel 2010 and Internet Explorer 11.0.56.
I’m somewhat comfortable with VBA but have never used it to navigate to a website, enter information and click on buttons. I’ve managed to muddle through as follows:
In Column A of my Excel spreadsheet, I have a list of 10 digit case numbers.
The code below will open IE, navigate to the desired website, pause while I log in, then navigate to the search screen, enter in the first case number and press the SEARCH button (yes, I have the case number in this example hard coded in with no looping, but that stuff I can handle so please ignore):
Sub Button_Click()
Dim objIE As Object
Set objIE = New InternetExplorerMedium
objIE.Top = 0
objIE.Left = 0
objIE.Width = 800
objIE.Height = 600
objIE.AddressBar = 0
objIE.StatusBar = 0
objIE.Toolbar = 0
objIE.Visible = True
objIE.Navigate ("https://somewebsite.com")
MsgBox ("Please log in and then press OK")
objIE.Navigate ("https://somewebsite.com/docs")
Do
DoEvents
Loop Until objIE.ReadyState = 4
objIE.Document.all("caseNumber").Value = "1234567890"
objIE.Document.getElementById("SearchButton").Click
Exit Sub
Do
DoEvents
Loop Until objIE.ReadyState = 4
MsgBox ("Done")
End Sub
That will bring me to this screen
The file number entered in the search field will return any number of files in a dynamic table with a checkbox to the left of each file.
For this example, let’s say I am ONLY concerned with the file called “CC8” under the “Type” column. There will only ever be one instance of “CC8” for a given file number.
What I need help with is, through VBA, how do I search through this table, find the “CC8” line, and then have the checkbox to the left automatically checked?
When I inspect the “CC8” element in IE, this is the HTML associated with it (highlighted in gray; the entire table is under class “listing list-view clearfix”)
see here
The HTML for the checkbox related to the “CC8” item is below:
HTML code here
The “id” for both has the same sequence of numbers, but one starts with “viewPages” and the other “doc”.
Can anyone help me out as to what I need to add to my code to get this checkbox checked? Thank you!
Note:
Please post the actual HTML using the snippet tool.
Generally:
Without HTML to properly test, I am assuming that the following 2 nodeLists are the same length, meaning that when the search text is found in aNodeList then the assumption is the same index can be used to target the corresponding checkbox in the bNodeList:
Dim aNodeList As Object, i As Long
With objIE.document
Set aNodeList = .querySelectorAll("a[target='_blank']")
Set bNodeList = .querySelectorAll("[title='Search Result: Checkbox']")
End With
For i = 0 To aNodeList.Length - 1
If aNodeList.item(i).innerText = "CC8" Then
bNodeList.item(i).Click
Exit For
End If
Next
You could also potentially use the following instead as you say the viewPages prefixes each item:
Set aNodeList = .querySelectorAll("a[id^='viewPages']")
Other observations:
Traditional checkboxes would have a checked attribute and syntax of
bNodeList.item(i).Checked = True, but as I can't see that attribute in your element I am assuming a .Click suffices.