Is there a way to runtime copy image from worksheet to userform image control?
I got a shape on a worksheet containing image. And when I select --> copy (ctrl + C) this shape, go to the UserForm1 design --> image1 properties I can do ctrl + v in the picture property of image1 and the image is pasted from clipboard to image1 control.
How can I achieve this using VBA in runtime?
I tried UserForm1.Image1.Picture = ActiveSheet.Shapes("Picture 1").Picture
And many similar bot none of them work
I usually get "Object doesn't support this property or method" or "Type mismatch"
Some time ago I was looking for a solution of the same problem. Did not find a solution, but I found a great workaround:
Make a separate form with plenty of pictures in it. Name it user_form_pics.
Then call the following on your form:
Me.Image1.Picture = user_form_pics.img_name11.Picture
This is how to use it in the constructor:
Private Sub UserForm_Initialize()
Me.Image1.Picture = user_form_pics.img_name11.Picture
End Sub
It works! Now your form has the picture of the user_form_pics.img_name11
Edit:
In case that you need to save Chart to picture, the procedure is the following:
Option Explicit
Public Sub TestMe()
Dim chtChart As Chart
Dim strPath As String
Set chtChart = ActiveSheet.ChartObjects(1).Chart
strPath = ThisWorkbook.Path & "\myChart.bmp"
chtChart.Export (strPath)
UserForm1.Show vbModeless
UserForm1.Image1.Picture = LoadPicture(strPath)
End Sub
Related
I have created a small add-in for my client. It adds 2 buttons to the toolbar and works OK. Now I'd like to add a third button to display the version number and a small help text (15 lines).
I wonder what is the easy way to do this. Options I can think of:
Insert (copy) a sheet with the help & version in the current workbook (efficient and easiest to do, but a bit rude and intrusive)
Create a VBA form with the help text in a label control, and a OK button (very nice, but label content cannot be formatted AFAIK)
write the info to a local HTML file and open that one (perhaps the more versatile?)
Any (other) suggestion ?
Note: I have no admin rights on my pc, so solutions involving additional software are excluded.
Here is the code of the UserForm I created, as per #Arul 's suggestion.
Option Explicit
Private helpFileName As String
Private Sub UserForm_Initialize()
helpFileName = Environ("temp") & "\test.htm"
writeHelpFile
WebBrowser1.Navigate "file:\\" & helpFileName
End Sub
Private Sub writeHelpFile()
Dim fso As Object, Fileout As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fileout = fso.CreateTextFile(helpFileName, True, True)
Fileout.Write Sheet4.Range("A1")
Fileout.Close
End Sub
Private Sub UserForm_Terminate()
Kill helpFileName
End Sub
I'm trying to create/copy/duplicate or whatever in excel VBA in shared workbook. My goal is to create new button, when workbook is shared.
In standart worksheet mode I tried which works in standart mode, but fail in shared (VBA dont know .add method of buttons)
Sub copyButton3()
Dim projectSheet As Worksheet
Set projectSheet = Sheets("Projects")
Dim newButton As button
With projectSheet
Set newButton = .Buttons("buttonToCopy").Add(10, 10, 10, 10)
With newButton
'some changes like name, size, caption, on action...
End With
End Sub
Then I tried Duplicate method, but with similar result as with Add
Sub copyButton3()
Dim projectSheet As Worksheet
Set projectSheet = Sheets("Projects")
Dim newButton As button
With projectSheet
Set newButton = .Buttons("buttonToCopy").Duplicate
With newButton
'some changes like name, size, caption, on action...
End With
End With
End Sub
Then I tried to use copy and paste, where i achieved some success with this. Finally, there is new button created, but I cant manipulate him, cause I can't select him. I tried assign selection to button variable, but in shared mode i'm getting Run time error 438 Object doesn't support this property or method (in normal mode everything works like a charm).
Sub copyButton()
Dim projectSheet As Worksheet
Set projectSheet = Sheets("Projects")
Dim newButton As Variant
With projectSheet
.Buttons("buttonToCopy").Copy
.Paste
Set newButton = Selection
With newButton
.Caption = "selected Button"
End With
End With
End Sub
So now I'm nearly out of ideas.
Is it even possible to cheat VBA to create new button in shared mode (I can create it) but to manipulate it later?
I have a VBA code in Visio that will change the color of the shape if said shape is hyperlinked. Right now, I run it by using a simple command button. I want the macro to run when a change occurs in the worksheet. I know in excel if I wanted to do that I would simply place my code in the Workbook_Change sub, but in Visio I am lost.
Here is my current code:
Private Sub CommandButton1_Click()
Dim Sh As Visio.shape
Dim Link As Hyperlink
For Each Sh In Visio.ActivePage.Shapes '<~ loop through the shapes collection
For Each Link In Sh.Hyperlinks '<~ loop through the links collection
If Not Link.Address = "" Then '<~ check for a blank address
Sh.Cells("Fillbkgnd").Formula = "RGB(255,102,0)"
Sh.Cells("Fillforegnd").Formula = "RGB(255, 102, 0)" '<~ apply a color to the shape
End If
Next Link
Next Sh
End Sub
Any ideas?
#JonFournier I have revisted this and here is my code that lives in ThisDocument:
Public WithEvents Pg As Visio.Page
Private Sub Pg_CellChanged(ByVal Cell As IVCell)
Set Pg = Pages("Page-1")
If Cell.Section = visSectionHyperlink Then
Dim Sh As Visio.shape
Dim Link As Hyperlink
For Each Sh In Visio.ActivePage.Shapes '<~ loop through the shapes collection
For Each Link In Sh.Hyperlinks '<~ loop through the links collection
If Not Link.Address = "" Then '<~ check for a blank address
Sh.Cells("Fillbkgnd").Formula = "RGB(255,102,0)"
Sh.Cells("Fillforegnd").Formula = "RGB(255, 102, 0)" '<~ apply a color to the shape
End If
Next Link
Next Sh
Else
End If
End Sub
The code that I put inside works perfectly fine when paired with a command button, but I would like it to work when the shape is changed. What else should I add to the code to "instantiate the object" or to get it to run the way I need it to. I can't seem to get anything to work. Appreciate the help.
Again, I am sorry this is appearing as an answer, my work firewalls will not allow me to comment for some reason.
You can catch the CellChanged event on the Page object, and check if the changed cell is in the hyperlink shapesheet section.
In a class module:
Public Withevents Pg as Visio.Page
Private Sub Pg_CellChanged(ByVal Cell as IVCell)
If Cell.Section = visSectionHyperlink Then
' call your code here
End If
End Sub
You would need to instantiate the object and keep it alive to monitor your active page, but this is the general gist of something that would work for you, I think.
This would also live happily in ThisDocument, if you'd prefer that.
Platform : MS Excel 2007(MS Visual Basic 6.0)
I have a few excel file with different textboxes in them.
All the textboxes were name. E.g TxTbox_AAAA, TxtBox_BBBB
Most of them have similar number of Textboxes with same name.
I also required to update the content inside the textboxes. But like i said... some excel file doesn't contain the textboxes.
E.g aaa.xls and bbb.xls have TexTbox_AAAA, TextBox_BBBB
and ccc.xls only have TexTbox_AAAA
my script is something like this
xlApp.ActiveSheet.TextBoxes("TextBox_AAAA").Text = TxtAAAA
xlApp.ActiveSheet.TextBoxes("TextBox_BBBB").Text = TxtBBBB
but if i run, it will encounter run-time error '1004':
Unable to get the TextBoxes property of the Worksheet class
which i suspect it is due to the excel doesn't have this textbox named "TextBox_BBBB"
so how do i put a check before xlApp.ActiveSheet.TextBoxes("TextBox_BBBB").Text = TxtBBBB
to check if this worksheet/activesheet doesn't contain TextBoxes("TextBox_BBBB"), it will not execute this step?
Since a TextBox is a Shape, here is one way to tell if a specific TextBox is on the activesheet:
Public Function IsItThere(sIn As String) As Boolean
IsItThere = False
If ActiveSheet.Shapes.Count = 0 Then Exit Function
For Each s In ActiveSheet.Shapes
If s.Name = sIn Then
IsItThere = True
Exit Function
End If
Next s
End Function
Not sure but try this:
Dim ws as Worksheet
Dim shp as Shape
Set ws = Activesheet '~~> change to suit
For Each shp in ws.Shapes
If shp.Name = "Textbox_Name" Then
'~~> your code here
End If
Next
Hope this helps
Thanks L42 and Gary's Student
I got it.. i should put
For Each s In xlApp.ActiveSheet.Shapes
instead of
For Each s In ActiveSheet.Shapes
only
Thanks for the help!!! =)
I'm developing a PowerPoint C# VSTO add-in. I want to be able to capture a text changed event whenever the Title text of a slide is changed.
How can I attach a custom event handler that will fire whenever the Title text is changed?
Two things: 1) this is in VBA, but should be easily portable to C# and VSTO, 2) The "text changed" thing is a bit tricky. I can get you as far as "are you in a Title box" - the rest is more trival. It has to do with finding original state versus any changes. Probably doable, I just haven't done it.
To hook a selection change in PPT VBA, you'll need one class and one module. In the class, put this:
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
With Sel
If .Type = ppSelectionText Then
Dim sh As Shape: Set sh = .ShapeRange(1)
If sh.Type = msoPlaceholder Then
originalText = sh.TextFrame.Text
Dim placeHolderType As Integer
placeHolderType = sh.PlaceholderFormat.Type
If placeHolderType = ppPlaceholderTitle Then
MsgBox "this is a title placeholder"
End If
End If
End If
End With
End Sub
Name the class "clsPPTEvents". Then in any module, put the following:
Public newPPTEvents As New clsPPTEvents
Sub StartEvents()
Set newPPTEvents.PPTEvent = Application
End Sub
Sub EndEvents()
Set newPPTEvents.PPTEvent = Nothing
Set newPPTEvents = Nothing
End Sub
Press F5 on the StartEvents and that will enable the hook. Press F5 on the EndEvents to disable it.