Chris Macro
04-15-2014, 07:48 PM
I am trying to bring over an image from another worksheet. At first I tried bringing over the original picture and recoloring it (the color is variable), however it doesn't appear that VBA supports recoloring/artistic settings. So I went ahead and recolored the image beforehand and thought I could simply copy paste the image and I would be done! Well, when I paste the image, it reverts back to it's original color! Any ideas on how to prevent this??? Thanks so much for your help!
Code:
Sub BringOverStatePic()'PURPOSE: Bring over state picture and recolor it
Dim Pic_sht As Worksheet
Dim Dash_sht As Worksheet
Dim Data_sht As Worksheet
Dim img As Shape
Dim l As Double
Dim t As Double
Set Pic_sht = ThisWorkbook.Worksheets(Pics.Name)
Set Dash_sht = ThisWorkbook.Worksheets(Dash.Name)
Set Data_sht = ThisWorkbook.Worksheets(DataPull.Name)
'Delete Current State Pic
For Each img In Dash_sht.Shapes
If InStr(1, img.Name, "State") <> 0 Then
t = img.Top
l = img.Left
'img.Delete
Exit For
End If
Next
'Copy New State Picture
If Range("PoliticalInfluence") = "Democrat" Then
myColor = "Blue "
Else
myColor = "Red "
End If
myState = myColor & "State " & Range("State").Value
Pic_sht.Activate
Pic_sht.Shapes(myState).Copy
'Paste New State Picture
Dash_sht.Activate
ActiveSheet.Paste
Selection.Left = l
Selection.Top = t
End Sub
Code:
Sub BringOverStatePic()'PURPOSE: Bring over state picture and recolor it
Dim Pic_sht As Worksheet
Dim Dash_sht As Worksheet
Dim Data_sht As Worksheet
Dim img As Shape
Dim l As Double
Dim t As Double
Set Pic_sht = ThisWorkbook.Worksheets(Pics.Name)
Set Dash_sht = ThisWorkbook.Worksheets(Dash.Name)
Set Data_sht = ThisWorkbook.Worksheets(DataPull.Name)
'Delete Current State Pic
For Each img In Dash_sht.Shapes
If InStr(1, img.Name, "State") <> 0 Then
t = img.Top
l = img.Left
'img.Delete
Exit For
End If
Next
'Copy New State Picture
If Range("PoliticalInfluence") = "Democrat" Then
myColor = "Blue "
Else
myColor = "Red "
End If
myState = myColor & "State " & Range("State").Value
Pic_sht.Activate
Pic_sht.Shapes(myState).Copy
'Paste New State Picture
Dash_sht.Activate
ActiveSheet.Paste
Selection.Left = l
Selection.Top = t
End Sub