picture formatting if/else

Y

y3tter

Board Regular
Joined
Nov 11, 2012
Messages
147
I'm having a problem getting the correct formatting based on a the text of cell AD5. I'm wanting specific formatting if AD5 contains "Gregg Donley" to crop an image a certain way and if AD5 contains any other name to crop differently. I've tried Select Case but it doesn't seem to work properly. Any help would be greatly appreciated.
<code style="font-family: monospace, monospace; margin: 0px 2px; border: 0px; border-radius: 2px; display: block; font-size: 1em; line-height: 1.42857142857143em; padding: 0px !important; background-color: transparent;">Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2 ' key up
Private Const VK_SNAPSHOT = &H2C ' print screen key
Private Const VK_MENU = &H12 ' alt key
Private Const VK_CONTROL = &H11 ' ctrl key
Sub ScreensCapture(vk)
keybd_event vk, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 1
keybd_event vk, 0, KEYEVENTF_KEYUP, 0
End Sub
Sub Window_Capture_VBA(Optional sTitle = "")
Dim celltxt As String
Application.CutCopyMode = False
If sTitle <> "" Then
AppActivate sTitle
Application.Wait Now() + TimeValue("00:00:01")
ScreensCapture VK_MENU
Else
ScreensCapture VK_CONTROL
End If
Application.Wait Now() + TimeValue("00:00:01")
Sheets("temp").Select
Sheets("temp").Paste
Application.CutCopyMode = False

Select Case Range("ad5").Value
Case "Gregg Donley"
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementTop 83.2499212598
Selection.ShapeRange.ScaleHeight 0.8928571429, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1438
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 777
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -41
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementLeft 306
Selection.ShapeRange.ScaleWidth 0.787278415, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1438
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 777
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = -153
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -41
ActiveWindow.SmallScroll Down:=21
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.ScaleHeight 0.873513627, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1438
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 777
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = -153
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 2
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.ScaleWidth 0.7284768212, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1438
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 777
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 2

Case Else

Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementTop 150.7499212598
Selection.ShapeRange.ScaleHeight 0.8081821253, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1445
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 785
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -75
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementLeft 353.25
Selection.ShapeRange.ScaleWidth 0.7556748605, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1445
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 785
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = -176
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -75
ActiveWindow.SmallScroll Down:=24
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementTop 0.00007874015748
Selection.ShapeRange.ScaleHeight 0.8584564145, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1445
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 785
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = -176
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -30
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.ScaleWidth 0.6823365858, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 1445
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 785
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = -3
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -30
End Select
Selection.Copy

Sheets(1).Activate

Call InsertXSec

End Sub

Sub xsection_Screen_Shot()
Window_Capture_VBA "SES" ' captures window titled "SES"


End Sub


Sub InsertXSec()
Range("L23").Select
ActiveSheet.Unprotect Password:=""
On Error Resume Next
Set n = ActiveSheet.Pictures.Paste()
With Range("G14")
t = .Top
l = .Left
End With
With n
.Top = t
.Left = l
.ShapeRange.LockAspectRatio = msoFalse
.Width = 768
.Height = 465
Application.ScreenUpdating = False
Application.CutCopyMode = False
End With
ActiveSheet.Pictures.Select
Call XSec
Application.ScreenUpdating = False
If Err Then MsgBox "You do not have an image in your clipboard.": Exit Sub
End Sub


Sub XSec()
'
' Macro3 Macro
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 1
End With

End Sub</code>
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Are you saying the Select Case doesn't work, or the picture formatting doesn't work?

If it's the Select Case, make sure the capitalization is the same in the cell value as in the Case. Also trim any trailing spaces.

Or use this...
Code: 
Select Case UCase(Trim(Range("AD5").Value))
Case "GREGG DONLEY"
 
Upvote 0
You must log in or register to reply here.

Similar threads

melodramatic
  • Question Question
Using VBA to set size and placement of picture
Replies
2
Views
12K
melodramatic
melodramatic
D
  • Question Question
How to insert (filenam) as PNG
Replies
1
Views
743
Dojorgen
D
I
  • Question Question
Saving New Screenshot on New Column
Replies
1
Views
692
iSoleil
I
C
  • Question Question
Paste Image from website then resizing, cropping, etc.
Replies
0
Views
2K
cerana
C
M
  • Question Question
Insert embed pictures to excell file bsed on cell value
Replies
6
Views
2K
pgc01
P

Forum statistics

Threads
1,223,238
Messages
6,170,939
Members
452,368
Latest member
jayp2104

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top