Realtreegirl75
New Member
- Joined
- Aug 28, 2022
- Messages
- 40
- Office Version
- 365
- Platform
- Windows
I'm working on a document for work and I need to have an "insert picture" button. I have a button with code that reliably works for landscape photos and puts them where the need to go(A100:AJ137), resizes, renames, etc. but the code only works for some portrait photos. Most of the time it drops portrait photos into (F95:AP128). The other catch is that this works on my work computer but not my personal computer?? I'm quite new to VBA so I'm still working through a lot of the things I'm trying to figure out on forums and youtube. The code for one of my insert picture buttons is below and any input would be greatly appreciated!
Sub GetPic2()
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
On Error Resume Next
ActiveSheet.Pictures("A100").Delete
If .Width > .Height Then
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveSheet.Range("A100").Left
.Top = ActiveSheet.Range("A100").Top
.Width = ActiveSheet.Range("A100:AJ100").Width
.Name = "A100"
.PrintObject = True
Else
If .Height > .Width Then
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveSheet.Range("A100").Left
.Top = ActiveSheet.Range("A100").Top
.Height = ActiveSheet.Range("A100:A137").Height
.Name = "A100"
.PrintObject = True
End If
End If
End With
End Sub
Sub GetPic2()
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
On Error Resume Next
ActiveSheet.Pictures("A100").Delete
If .Width > .Height Then
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveSheet.Range("A100").Left
.Top = ActiveSheet.Range("A100").Top
.Width = ActiveSheet.Range("A100:AJ100").Width
.Name = "A100"
.PrintObject = True
Else
If .Height > .Width Then
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveSheet.Range("A100").Left
.Top = ActiveSheet.Range("A100").Top
.Height = ActiveSheet.Range("A100:A137").Height
.Name = "A100"
.PrintObject = True
End If
End If
End With
End Sub