I am working on a project of a memory card game (where all cards are hidden and you have to find pairs of cards by looking at 2 cards at a time), so I made the code works with letters inside of cells and displaying "[x]" for hidden cards.
Now I am trying to move to images, the problem is : I can't just put the *.jpg in the folders, Images need to be embedded in the excel file, so I created a "Data" sheet with all my images (hidden and unhidden).
They are named as follow : "christmashidden", "christmasA", "christmasB" etc..
Now i wan't to have my macro to take these shapes and copy them to another worksheet (the "Plate" worksheet for instance) dynamically.
So i'm about to create a function like :
Function PlaceImgInCell(Target As Range, PairID As String, ThemeName As String) As Shape
'This function will be called by the main function to place a specific image in a specific cell
'and return the image shape object if any manipuation is needed afterward
Dim TargetImg As Shape
Dim BaseImg As Shape
Set BaseImg = ThisWorkbook.Worksheets("Data").Shapes(ThemeName & PairID) 'l'image de base, on la duplique pour la placer au bon endroit
BaseImg.Copy
but I think that copying and pasting each relevant shape everytime we need to change from hidden to shown might be long to display and not efficient, but i don't know any other way to do, what are the options at my disposal ? Thanks !
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 have a userform in Excel 2016 that will generate a certain group of shapes (a welding symbol, if the context is helpful), mainly consisting of lines, arcs, and textboxes. Some of these will be the same every time the code is run, while others are options to be determined by the user via the userform. At the end those elements are grouped into a single symbol. My current code works as described thus far.
The problem comes when I try to run the form a second time (generating a second group of shapes independent of the first group). I have it set up such that as the code is executed, it creates a shape, names that shape appropriately, then groups all shapes at the end, referring to them by name. The second time the code is run, it uses the same names as in the first run. As soon as it tries to form the second group, I get an error due to names referring to two different shapes.
My question is this: Is there a way to add shapes to a group (or to a collection to be grouped later) as they are created? It seems naming shapes isn't the way to go, as the names are retained after the code ends. I tried referencing by shape index, but since I have images on the page as well, it's hard to determine exactly what a particular shape's index is. I apologize for the lack of code, as I don't have access to it right now. If needed I can write up something simple to get the point across. Any help is greatly appreciated!
You can group shapes with a command like this:
Dim ws as Worksheet
Set ws = ActiveSheet ' <-- Set to the worksheet you are working on
ws.Shapes.Range(Array("Heart 1", "Sun 2", "Star 3")).Group
(you can access the shapes via name or via index). The result of the group command is another shape that is added to the sheet. But be aware that the grouped shapes still exists in the sheet, you can access them with the GroupItems-property.
With ws.Shapes
Dim shGroup As Shape, sh As Shape
Set shGroup = .Range(Array("Heart 1", "Sun 2", "Star 3")).Group
shGroup.Name = "MyNewGroup" & .Count
For Each sh In shGroup.GroupItems
Debug.Print sh.Name, sh.Type
Next sh
End With
As you can see, the single shape elements don't change their names, so grouping would not solve your naming issue. The only way is to add a suffix to the name, e.g. a number (as Excel does it when it creates a shape).
Update: Of course the Array- parameter does not need to be static. You can declare an array that is large enough (it doesn't matter if it contains some empty elements).
Const maxShapes = 12
Dim myShapes(1 to maxShapes) as String
myShapes(1) = *Name of first shape you created*
myShapes(2) = *Name of second shape you created*
...
ws.Shapes.Range(myShapes).Group
or use the Redim command:
Dim myShapes() as String
Redim myShapes(1 to NumberOfShapesInYourNewGroup)
myShapes(1) = *Name of first shape you created*
myShapes(2) = *Name of second shape you created*
...
ws.Shapes.Range(myShapes).Group
To get a unique shape and group name, you can implement various methods. I don't like the attempt with a global variable as they might get reset - for example when you cancel execution during debugging. You could use for example the suffix that Excel generates when you create a new shape. Or put the rename-statement into a loop, put a On error Resume Next before the rename (and don't forget to put an On error Goto 0 after it) and loop until renaming was successfull. Or loop over all shapes in your sheet to find the next free name.
After some trial and error, the solution I came up with is something like the following.
'Count shapes already on sheet
Shapesbefore=ActiveSheet.Shapes.Count
'Create new shapes
'Create array containing indexes of recently created shapes
Dim shparr() As Variant
Dim shprng As ShapeRange
ReDim shparr(Shapestart + 1 To ActiveSheet.Shapes.Count)
For i = LBound(shparr) To UBound(shparr)
shparr(i) = i
Next i
'Group shapes and format weight/color
Set shprng = ActiveSheet.Shapes.Range(shparr)
With shprng
.Group
.Line.Weight = 2
.Line.ForeColor.RGB = 0
End With
This way I don't have to worry about creating and managing various group and shape names, as I don't need to go back and reference them later.
I meet a problem which is probably very simple when I use a VBA function into a formula of a cell, I get the cell content "#NAME" (not found function ? while a macro using the function (for test) is executed normally (displays the wished content for the cell, the returned value by the function, which extracts the filename from a fullpath).
context :
I had by the past (more than 12 years ago) developed, may be 50,000, VBA instructions, using office2003.
Today I have to develop again some macros with Office365. So I have forgotten a lot since this time and some features can have changed which can become tricking (I need to read again my old soft to recall all my knowledge, but I have no access to for now)
The problem
I get the error "#name" when I use a function created into VBA
associated to the current workbook. No explanation, no help, I tried to
find something during several hours and I found nothing.
I have developed too for testing (see code) a "sub" which calls the function, and his execution is successful, but...
I cannot run the function from the formula of any cell.
I have tested the security parameters of macro and fully unlocked the execution temporarily, and too declare the local directory as confident area.
Note : this code is detailed as an example
The code
Public Function FNameOf(CellPointed As Range)
Dim CurCell As Range
Dim Text1 As String
Dim Text2 As String
Set CurCell = CellPointed
Text1 = CurCell.Value
Text2 = Mid$(Text1, InStrRev(Text1, "\") + 1, Len(Text1))
FNameOf = Text2
End Function
Sub DispFileName2()
Dim style, disp, titre
Dim Cursel As Range
'Cursel = ActiveCell
disp = FNameOf(ActiveCell)
style = vbOKOnly
titre = "Nom du fichier extrait du texte (fullpath) de la cellule courante"
MsgBox disp, style, titre
End Sub
If I submit the macro DispFileName2 if get the message with the file name extracted from the path which is the content of the current cell
If I set the formule of a cell :
=FNameOf(AnotherCell) 'which contains a fullpath to a file
I get always the error "#NOM" (in French version) or, I think so, "#NAME" (in english Version) as if the function name (ref) was unknown from the workbook (the code is not reached, a stop is set on the first instruction)
What can be the reason ?
Please place your user defined function somewhere in a module (neither in "ThisWorkbook" nor in the individual worksheet's code, e. g. "Feuil1").
You should add the result declaration As String also.
I understood the example is for reference only, but you may shorten it:
Public Function FNameOf(CellPointed As Range) As String
FNameOf = Mid(CellPointed.Value, InStrRev(CellPointed.Value, "\") + 1)
End Function
I just got the solution while reading in more details previous edited threads in several tabs.
It is explained into a remark of : thread 12351339
The text is :
Microsoft Excel Objects such as 'Sheet1' or 'ThisWorkbook' are
classes. I don't believe you can access Functions which you put in
these classes through a cell. You could access them in VBA e.g.
ThisWorkbook.Square2() but it's recommended to put all UDF's into as
standard module and not a worksheet module. – Eddie Sep 28 '17 at
13:49
By default the creation panel defines code associated to current worksheet, then the function is not visible for the worksheet while the sub is a macro of the worksheet.
I have created a module and the function has run immediately.
Best regards
Trebly
Note : I never met this problem of visibility before because the developments where since the beginning concerning VBA user classes and modules combining multiple Excel workbooks and Word and a Mail manager activeX and so on...
I keep the subject because of the explanations, code and keywords may be to find more easily the solution for anybody else.
I'm using vba to create an excel document and fill it in dynamically (already completed and working perfectly). What I need is: to figure out how to add, size, position, and prefill (suggested signer, email, but not the signature itself) the signature block at multiple locations in this document.
I don't even know if this can be done with vba (my searches on the subject have been unhelpful), but I'm hopeful as it will save me a lot of time and tedious work in the future. Any help on this would be welcome.
You may want to place simple text boxes across defined cells (as anchor points) and fill it with some text. To get you started here's the bare minimum that you need:
the actual text box creating Sub which takes all info as parameters:
Sub CreateShapeText(NailToCell As Range, w_pt As Single, h_pt As Single, DTxt As String)
Dim TB As Shape
' create a text box shape
' note: shapes belong to worksheets, therefore we derive a WS from cell.parent
Set TB = NailToCell.Parent.Shapes.AddLabel(msoTextOrientationHorizontal, NailToCell.Left, NailToCell.Top, w_pt, h_pt)
' make its border visible
TB.Line.Visible = msoTrue
' switch off that annoying auto-resize when text is entered
TB.TextFrame2.AutoSize = msoAutoSizeNone
' enter text ... and yes - this object tree is crazy
TB.TextFrame2.TextRange.Characters.Text = DTxt
' as it should be - text is vertical bottom
' but to have more control over the TB, this could be a parameter, too
TB.TextFrame2.VerticalAnchor = msoAnchorBottom
End Sub
and you would call that from wherever in your code as in below example
Sub CallCreate()
CreateShapeText [A1], 132, 32, "sign: me"
CreateShapeText [C12], 132, 32, "sign: you"
End Sub
You take it from here and research what these objects can do for you (e.g. make dotted lines instead of solid for the frame, experiment with font sizes, alignments etc.) and come back with more questions in case ...
I am looking to import/copy data from many workbooks into a summary workbook. The workbooks are arranged in different sub-folders, I.e
C:\data1\results_2001.xlm
C:\data2\results_2002.xlm
C:\data3\results_2003.xlm
The names are similar but differ slightly to differentiate them. At present, I import the files individually, and I want to automate the process. The results files (above) are amongst other excel files so I cannot target them by file type.
How would I import these files by partial file name?
One option is to create an array of the filepaths to your excel sheets and then loop over the array and get the data you want into your summary sheet.
Sub CreateSummary()
Dim wkbs() As Variant, wkb As Integer, owb As Workbook
wkbs = Array("C:\data1\results_2001.xlm", "C:\data2\results_2002.xlm", "C:\data3\results_2003.xlm")
For wkb = 0 To UBound(wkbs)
Set owb = Application.Workbooks.Open(wkbs(wkb)) //Open each workbook
With owb
//Get the data you want into your summary workbook
.Close
End With
Next wkb
End Sub
Another way, especially if only a one time operation: Go into Cmd.exe, do a Dir for the files you're looking for, and send it to a text file (eg, something like dir c:\results_*.xlm /s /b > c:\myList.txt). Then import the text file to your worksheet, step thru each cell in the list, opening each workbook in turn.
You can do it in any languages, but for you who is asking this question, i think it's gonna be a little challenging, so here is what you need to do :
create a function that will list files/folders from given path
loop through all items found, if it's a folder , recursive it
if the item fits your target(name, extension, ...) , read it and load the content to the summary
something like this, i believe you will achieve this easily using VBA, look here
Literally, it will be like this, please note that this is not valid code, just something i write down to help you figure it out :
function loopthepath (string pathtoloop)
foreach(dirItem item in pathtoloop.getdirItem)
{
if (item is folder)
{
loopthepath(pathtoloop + item)
}
else
{
if (item fits mydescription)
{
load the content to the summary
}
}
}