I would like a VBA code to put this button lets say two cells (to the right) away from a cell in the sheet called "hello". Here's the command button code:
Set objBtn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=480, Top:=200, Width:=90, Height:= _
30)
objBtn.Name = "button1"
I don't want to use the cell location as reference, instead the cell value which is "hello". So maybe first I want to look for the value and then insert the command button relative to it.
Yes, that's the way to do it, e.g.
Sub x()
Dim objBtn As OLEObject, r As Range
Set r = Cells.Find("hello") 'should specify more parameters than this
If Not r Is Nothing Then
Set objBtn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=r.Offset(, 2).Left, Top:=r.Top, Width:=90, Height:=30)
objBtn.Name = "button1"
End If
End Sub
'You can fixe a button to a specific cell here to cell A1
Dim rngcbn1 As Range
Set rngcbn1 = ActiveSheet.Range("A1")
With ActiveSheet.OLEObjects("CommandButton1")
.Top = rngcbn1.Top
.Left = rngcbn1.Left
.Width = rngcbn1.Width
.Height = rngcbn1.RowHeight
End With
Related
I'm using the code below to add a toggle button to sheet. I will need to dynamically re-create a sequence of buttons, and give them name and caption.
Can anyone help me with a way to change the caption/text of the toggle button button added using VBA? The bName will change so I will need a way to reference them by name.
Set Bttn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ToggleButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height)
With Bttn
.Name = bName
End With
where R is the target cell where button will be added
I tried the following, and they all error out:
Bttn.caption = bText
ActiveSheet.Shapes(bName).Text = bText
Or, simply . . .
With Bttn
.Name = bName
.Object.Caption = "MyCaption"
End With
I found this workaround here: https://stackoverflow.com/a/37978572/9852011
Not sure why you need to do this exactly but this code should work for you:
Dim Bttn As OLEObject, aButton As Variant
Set Bttn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ToggleButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height)
With Bttn
.Name = bName
End With
Set aButton = Bttn.Object
aButton.Caption = "whateverYouWant"
I'm trying to add borders to a table that I have copied to word from excel. I haven't defined the table name but using the Range.Paste method, does anyone know how to add borders to the table-Below is the code that I am using
ThisWorkbook.Sheets("Participants - C").Range("C7:D13").Copy
docWord.Bookmarks("TransParties").Range.Paste
You can use this code:
Sub test()
'add your code, e.g. set docWord etc. here
ThisWorkbook.Sheets("Participants - C").Range("C7:D13").Copy
With docWord.Bookmarks("TransParties").Range
.Paste
Dim tbl As Word.Table
Set tbl = .Tables(1)
addBorders tbl
End With
End Sub
Private Sub addBorders(tbl As Word.Table)
Dim arrBorders As Variant
'WdBorderType
arrBorders = Array( _
wdBorderBottom, _
wdBorderTop, _
wdBorderLeft, _
wdBorderRight, _
wdBorderVertical, _
wdBorderHorizontal _
)
Dim b As Long
With tbl.Borders
For b = LBound(arrBorders) To UBound(arrBorders)
With .Item(arrBorders(b))
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.color = wdColorAutomatic
End With
Next
End With
End Sub
In Word VBA you have to set each border individually :-(
G'day all, I'm trying to create a button that opens the dialogue box, allows the user to
select a photo from their files,
embeds that file to the particular cell that the button exists in,
and allows it to move and size along with that cell, while maintaining aspect ratio (thanks for the pickup dbmitch)
I have successfully done that using the expression.Insert.Picture() method, but had a rude surprise when I sent the sheet out and all the pictures were replaced with "Photo has been moved, deleted or edited." It seems this method only links the file, which certainly won't work for me, so now I'm trying the much older method of expression.shapes.addPicture(). I think I am successfully adding the photo, but can't seem to get the sizing or locking to cell to work. Please see both attempts below-
Sub GetPic()
Dim fNameAndPath As Variant
Dim img As Picture
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub
Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
With img
'Resize Picture to fit in the range....
.Left = ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Left
.Top = ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Top
.Width = ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Width
.Height = ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Height
.Placement = 1
.PrintObject = True
End With
End Sub
Sub TestPic()
Dim ws As Worksheet, s As Shape
Set ws = ActiveSheet
' Insert the image.
Set s = ws.Shapes.AddPicture(Application.GetOpenFilename(Title:="Please work"), _
False, True, ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Left, _
ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Top, _
ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Width, _
ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Height)
' Use picture's height and width.
End Sub
I was able to get this code to run in Excel 2016 VBA. You don't say where you're running this from but I assume Application.Caller is not from a module? Maybe a Userform?
Here's what worked for me - hopefully you can use it
Sub TestPic()
Dim ws As Worksheet, s As Shape
Dim sngLeft As Single, sngRight As Single, sngTop As Single, sngWidth As Single
Set ws = ActiveSheet
' Insert the image.
With ActiveCell.Cells
sngLeft = .Left
sngTop = .Top
sngWidth = .Width
sngheight = .Height
End With
Set s = ws.Shapes.AddPicture(Application.GetOpenFilename(Title:="Please work"), _
msoFalse, msoTrue, sngLeft, sngTop, sngWidth, sngheight)
s.Placement = xlMoveAndSize ' move and resize when cell dimensions change
'ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Left, _
'ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Top, _
'ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Width, _
'ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Height)
' Use picture's height and width.
End Sub
I have a PowerApp which updates a cell in an Excel file hosted in OneDrive. The Excel file contains a macro that is supposed to run when the PowerApp changes the Excel file. However, it doesn't do that. If I update a cell manually, the macro works just fine. It's just not activated when the file is updated by PowerApps.
Is there a different function I can use that will be triggered when PowerApp changes the file?
If that is not possible, could I use a Flow to activate the macro?
Here is the current script that works with manual changes, but not the automatic PowerApps changes.
Private Sub Worksheet_Change(ByVal Target As Range)
Call InsertImageTest
End Sub
Here is the macro that I want to trigger using the code above.
Sub InsertImageTest()
' This macro inserts an image from a set location to a set cell.
Dim ws As Worksheet
Dim imagePath As String
Dim cell As String
Dim posText As String
Dim imgLeft As Double
Dim imgTop As Double
Dim rngX As Range
Dim activeSheetName As String
' Customizable variables
imagePath = ActiveWorkbook.Path & Range("$B$2").Value
posText = "Signature"
activeSheetName = "Data" ' Set to "Data" by default, but will change to the Active sheets name, if the active sheet is not called "Data"
' For i = 1 To Sheets.Count
' If CStr(Sheets(i).Name) Is CStr(activeSheetName) Then
' Debug.Print "Code can be executed! Data tab was found"
' End If
' Next i
cell = "$A$1"
Set ws = ActiveSheet
Set rngX = Worksheets(activeSheetName).Range("A1:Z1000").Find(posText, lookat:=xlPart)
If Not rngX Is Nothing Then
cell = rngX.Address
Debug.Print cell
Debug.Print rngX.Address & " cheating"
Worksheets(activeSheetName).Range(cell).Value = ""
Debug.Print rngX.Address & " real"
imgLeft = Range(cell).Left
imgTop = Range(cell).Top
' Width & Height = -1 means keep original size
ws.Shapes.AddPicture _
Filename:=imagePath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=imgLeft, _
Top:=imgTop, _
Width:=-1, _
Height:=-1
End If
' The code beaneath will resize the cell to fit the picture
For Each Picture In ActiveSheet.DrawingObjects
PictureTop = Picture.Top
PictureLeft = Picture.Left
PictureHeight = Picture.Height
PictureWidth = Picture.Width
For N = 2 To 256
If Columns(N).Left > PictureLeft Then
PictureColumn = N - 1
Exit For
End If
Next N
For N = 2 To 65536
If Rows(N).Top > PictureTop Then
PictureRow = N - 1
Exit For
End If
Next N
Rows(PictureRow).RowHeight = PictureHeight
Columns(PictureColumn).ColumnWidth = PictureWidth * (54.29 / 288)
Picture.Top = Cells(PictureRow, PictureColumn).Top
Picture.Left = Cells(PictureRow, PictureColumn).Left
Next Picture
End Sub
Unfortunately the server opens Excel through APIs and Excel doesn't fire macros in this way. It seems flow has the same. I would consider implement the macro function logic in PowerApps. Customize the edit form of the column which supposes to trigger the macro, depends what the macro should do. Possibly unlock a data card if the macro trys to alter a value of another column.
The following code makes me able to select only one cell (in this case A3), click on a button and bring a picture. The nagative thing is that i need it to work also on other cells (from A3 to A22) and i don't know how to modify the code in order to do so. Any suggestions? Thank you
Private Sub cmdDisplayPhoto_Click()
Application.ScreenUpdating = False
Dim myObj
Dim Pictur
Set myObj = ActiveSheet.DrawingObjects
For Each Pictur In myObj
If Left(Pictur.Name, 7) = "Picture" Then
Pictur.Select
Pictur.Delete
End If
Next
Dim Exercise As String, T As String
myDir = "C:\Users\Computer\Desktop\Pictures of Exercises\"
Exercise = Range("A3")
T = ".PNG"
ActiveSheet.Shapes.AddPicture Filename:=myDir & Exercise & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=770, Top:=60, Width:=160, Height:=150
Application.ScreenUpdating = True
End Sub
Try changing...
Exercise = Range("A3")
to
if ActiveCell.column = 1 then Exercise = ActiveCell Else Exit Sub
This will use the text of whatever cell is selected for the picture and only accept cells from column A.