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.
Related
I have 2 sheets on excel , first one with some rows and columns , an ActiveX control Button and checkbox , when i click on this button i execute this code :
Private Sub CommandButton1_Click()
If CheckBox1.Value = True Then Call do_OM
End Sub
Private Sub do_OM()
Dim Name_sheet As String
Dim row_se As Long
Dim Vl_1 As String
row_se = CheckBox1.TopLeftCell.Row
Vl_1 = Range("D" & row_se)
Name_sheet = ActiveSheet.Name
Sheets("Or_Mission").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "OM" & & Name_sheet
Range("C11") = Vl_1
MsgBox Range("C11") & Vl_1
ActiveWorkbook.Save
End Sub
What i want is to copy the value of ( Vl_1 = Range("D" & row_se) ) that exists in first sheet TO the second sheet using Range("C11") = Vl_1
The problem is The msgBox shows exactly the wanted result , But in the second sheet Range("C11") is empty !! i don't know what's happening , if any one can help
How can msgBox of Range("C11") that's in sheet 2 shows the value while in excel The cell is always empty ??
At the same time im using MsgBox becaus Debug.Print doesn't print anything ?? don't know why
Thank you :) .
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.
So i have been at this for a while now and I have searched through many websites and forums but alas I can not find a solution to my issue.
I am trying to add arguments to an .OnAction event for a Checkbox
So.. For example
Dim chk as Checkbox
With chk
.name = "chk" & .TopLeftCell.Offset(0, -7).Text
.Caption = ""
.Left = cel.Left + (cel.Width / 2 - chk.Width / 2) + 7
.Top = cel.Top + (cel.Height / 2 - chk.Height / 2)
.OnAction = "CheckboxHandle(chk)"
End With
So if I was trying to call this sub -> Public Sub CheckboxHandle(obj As CheckBox)
It requries a CheckBox Object to be able to run (this can change to a shape/Object if necessary)
THINGS I HAVE TRIED
Changing the data type to object and shape however i couldn't find a way to pass it through
Variations of the below statements
"""CheckboxHandle(chk)"""
"'CheckboxHandle" ""chk"" '"
Application.caller then looping through objects to find the object whit that name (this takes way too long as I have over 300 Checkboxes)
CONTEXT
In case the context helps I am trying to add a checkbox to every cell in a range and then have each one call the same method when they are clicked. I need the OnAction to send an Object as i look for the TopleftCell of the Object to change the colour of the adjacent cells
IN CASE IT IS HELPFUL
here is the method i would like to call from the OnAction Event
Public Sub CheckboxHandle(obj As CheckBox)
Dim rng As Range
'Sneaky sneaky changes
Application.ScreenUpdating = False
'For Loop to go through each of the cells to the left of the check box
For Each rng In Range(obj.TopLeftCell, obj.TopLeftCell.Offset(0, -7))
With rng
'if the checkbox is checked
If obj.Value = -1 Then
.Interior.Color = RGB(202, 226, 188)
'Adds the date and the person so you know who did the edit
obj.TopLeftCell.Offset(0, 1).Value = Now & " by " & Application.username
Else
'if it isn't checked
.Interior.Pattern = xlNone
'removes the edit name and date
obj.TopLeftCell.Offset(0, 1).Value = ""
End If
End With
Next rng
'Shows all the changes at the same time
Application.ScreenUpdating = True
'Changes the value of the progress bar to represent the project completion
If obj.Value = -1 Then
ActiveSheet.Range("E1").Value = ActiveSheet.Range("E1").Value + 1 / 207
Else
ActiveSheet.Range("E1").Value = ActiveSheet.Range("E1").Value - 1 / 207
End If
End Sub
Any help on this issue would be much appreciated
-Sebic0
I don't think that you can pass an object via the OnAction. The OnAction-property is a string holding the name of a Sub (plus parameter).
You could try to pass the name of the checkBox instead. Note that you have to enclose the name of the checkbox in double quotes, so that you would get something like. CheckboxHandle "chk123":
.OnAction = "'CheckboxHandle """ & .Name & """'"
And change your Action-routine
Public Sub CheckboxHandle(chbBoxName as string)
dim chk as CheckBox
Set chk = ActiveSheet.CheckBoxes(chkBoxName)
(...)
I use the following code to allow users to write a value into Cell A1.
Sub TestUsername()
If Environ("Username") = "firstname1.lastname1" Or Environ("Username") = "firstname2.lastname2" _
Or Environ("Username") = "firstname3.lastname3" Or Environ("Username") = "firstname4.lastname4" Then
Sheet1.Range("A1").Value = 1
Else
Sheet1.Range("A2").Value = 2
End If
End Sub
As you can see I list each user who is allowed to enter a value into Cell A1 with an OR-condition in my VBA code. All this works fine.
Now, I was wondering if there is an easier way to do this. Something like this:
Sub TestUsername()
If List of or-conditions: {"firstname1.lastname1", "firstname2.lastname2", _
"firstname3.lastname3", "firstname4.lastname4"} = True Then
Sheet1.Range("A1").Value = 1
Else
Sheet1.Range("A2").Value = 2
End If
End Sub
I just know in PHP you can compress multiple conditions like here. Therefore, I thought this might also be possible for VBA programming.
Maybe something like this
Sub TestUsername()
Select Case Environ("Username")
Case "firstname1.lastname1", "firstname2.lastname2", "firstname3.lastname3"
Sheet1.Range("A1").Value = 1
Case Else
Sheet1.Range("A2").Value = 2
End Select
End Sub
I suppose, if you had an atrocious amount of conditions, you could stick them in an array and then simply replace your conditional statement
If Environ("Username") = "firstname1.lastname1" Or Environ("Username") = "firstname2.lastname2" _
Or Environ("Username") = "firstname3.lastname3" Or Environ("Username") = "firstname4.lastname4" Then
with this
If IsInArray(Environ("Username"), arr) Then
This does require that you dimension an array with the conditions first and use this function, however:
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i
For i = LBound(arr) To UBound(arr)
If arr(i) = stringToBeFound Then
IsInArray = True
Exit Function
End If
Next i
IsInArray = False
End Function
This way, your code becomes much more readable and easy to maintain.
Since you're working in a cell, you might want to define the allowed usernames within the spreadsheet.
Here's how the spreadsheet table might look:
And here's the code you might use:
Sub TestUsername()
Dim username As String
Dim userInTable As Integer
Dim allowedUserRange As Excel.Range
username = Environ("username")
Set allowedUserRange = Excel.Range("tUsers")
userInTable = Excel.WorksheetFunction.CountIf(allowedUserRange, username)
If userInTable Then
Sheet1.Range("A1").Value = 1
Else
Sheet1.Range("A1").Value = 2
End If
End Sub
The Select Case provides a great solution to testing multiple conditions at the same time. I am using this to alert the user when they have not furnished all the required inputs. I am monitoring inputs from a number of Drop Down Boxes as well as some direct cell inputs.
Select Case True
Case Range("Customer_DD_Control_Cell") > 0 _
And Range("Dealer_DD_Control_Cell") > 0 _
And Range("Rep_DD_Control_Cell") > 0 _
And Range("Product_DD_Control_Cell") > 0 _
And Len(Range("Customer_State_Input")) > 0 _
And Len(Range("Contract_Date_Input")) > 0
Case Else
MsgBox "You have not completed the required inputs"
End Select
I'm trying to write a macro which will copy data from one spreadsheet to another spreadsheet within the same workbook using Marco assigned to a active control button. Also, I would the button to clear the data from fields after copying to the other sheet. However, I'm struggling to Debug this code. Can anyone offer assistance?
Private Sub CommandButton1_Click()
Dim OrderDate As String, Job As String, AccountManager As String
Dim Site As String, DueDate As String, BudgetedHours As String
`enter code here`Supervisor As String
Dim TotalPieces As String, Billedhours As String, UnitsCompleted As String
Dim EmployeeName As String, Task As String
Dim StartTime As String, FinishTime As String, TotalTime As String
Dim Notes As String
Worksheets("Assembly Work Form").Select
Date = Range("B3")
Job = Range("B4")
CustomerName = Range("B5")
AccountManager = Range("B7")
Supervisor = Range("B8")
Site = Range("B9")
DueDate = Range("B10")
BudgetedHours = Range("B11")
TotalPieces = Range("F5")
Billedhours = Range("F3")
UnitsCompleted = Range("F6")
EmployeeName = Range("B15")
Task = Range("B15")
StartTime = ("E17")
FinishTime = ("G17")
TotalTime = ("I17")
Notes = Range("K17")
Worksheets("AssemblyTotals").Select
Worksheets("AssemblyTotals").Range("A2").Select
If Worksheets("AssemblyTotals").Range("A3").Offset("1,0") <> "" Then
Worksheets("AssemblyTotals").Range("A2").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Date
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Job
ActiveCell.Offset(-1, 0).Select`enter code here`
ActiveCell.Value = CustomerName
Worksheets("Assembly Work Form").Select
Worksheets("Assembly Work Form").Range("DataFields").ClearContents
End Sub
Basically, what you want to do is the following:
Private Sub CommandButton1_Click()
Worksheets("AssemblyTotals").Range("SomeTargetAddress").Value = Worksheets("Assembly Work Form").Range("SomeSourceAddress").Value 'Copy a value
Worksheets("Assembly Work Form").Range("SomeSourceAddress").ClearContents 'Clear the original value
End Sub
Of course change the "SomeTargetAddress" and "SomeSourceAddress" to valid cell references. Also keep in mind you can do multiple cells at once:
Private Sub CommandButton1_Click()
Worksheets("AssemblyTotals").Range("A2:A100").Value = Worksheets("Assembly Work Form").Range("A2:A100").Value 'Do 99 cells at once
End Sub
And if you want to start on the first empty row:
Private Sub CommandButton1_Click()
Dim wr as Long 'Variable to store the row
wr = Worksheets("AssemblyTotals").Range("A2").End(xlDown).Row + 1
Worksheets("AssemblyTotals").Range("A" & wr).Value = Worksheets("Assembly Work Form").Range("A2:A100").Value 'Do 99 cells at once starting at the first empty row in Column A.
End Sub
No need to store everything in variables first, unless you intend to use those variables in more places later on. Also, note that you shouldn't use ActiveCell and Select, etc. as mentioned in my comment.
Based on the above, all you have to do now is just map the cells correctly and that's it.