Private Sub Worksheet con 2 funciones diferentes
Hola mucho agradecere su ayuda con lo siguiente:
necesito que aparte del siguiente codigo tambien me modifique automaticamente el color de la celda F18 que se cambia por medio de un inserto que tengo pormedio de BUSCARV
el codigo es para insertar una imagen en otro rango de celdas
ACTUALMENTE TENGO:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Foto As Object, Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
Dim ruta As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Target = [f7] Then Exit Sub
Me.Shapes("Foto").Delete
ruta = ThisWorkbook.Path & "\FOTOS\" & [f7] & ".jpg"
Set Foto = Me.Pictures.Insert(ruta)
With Range("B7:E12")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With Foto
.Name = "Foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Application.ScreenUpdating = True
End Sub
Y DESEO AGREGAR:
If Target.Value = "" Then Target.Interior.ColorIndex = 0
If Target.Value = "PULIDO" Or Target.Value = "pulido" Then Target.Interior.ColorIndex = 29 'morado
If Target.Value = "AUXILIAR" Or Target.Value = "auxiliar" Then Target.Interior.ColorIndex = 9 'cafe9
If Target.Value = "MEDIO OFICIAL" Or Target.Value = "medio oficial" Then Target.Interior.ColorIndex = 51 'verde51
If Target.Value = "OFICIAL" Or Target.Value = "oficial" Then Target.Interior.ColorIndex = 25 'azul25
If Target.Value = "MAESTRO OFICIAL" Or Target.Value = "maestro oficial" Then Target.Interior.ColorIndex = 3 'rojo
If Target.Value = "SUPERVISOR" Or Target.Value = "supervisor" Then Target.Interior.ColorIndex = 46 'color46
If Target.Value = "JEFE DE PRODUCCION" Or Target.Value = "jefe de produccion" Then Target.Interior.ColorIndex = 1 'negro
If Target.Value = vbNullString Then Target.Interior.ColorIndex = 0
DE ANTEMANO GRACIAS POR EL INTERES.
necesito que aparte del siguiente codigo tambien me modifique automaticamente el color de la celda F18 que se cambia por medio de un inserto que tengo pormedio de BUSCARV
el codigo es para insertar una imagen en otro rango de celdas
ACTUALMENTE TENGO:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Foto As Object, Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
Dim ruta As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Target = [f7] Then Exit Sub
Me.Shapes("Foto").Delete
ruta = ThisWorkbook.Path & "\FOTOS\" & [f7] & ".jpg"
Set Foto = Me.Pictures.Insert(ruta)
With Range("B7:E12")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With Foto
.Name = "Foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Application.ScreenUpdating = True
End Sub
Y DESEO AGREGAR:
If Target.Value = "" Then Target.Interior.ColorIndex = 0
If Target.Value = "PULIDO" Or Target.Value = "pulido" Then Target.Interior.ColorIndex = 29 'morado
If Target.Value = "AUXILIAR" Or Target.Value = "auxiliar" Then Target.Interior.ColorIndex = 9 'cafe9
If Target.Value = "MEDIO OFICIAL" Or Target.Value = "medio oficial" Then Target.Interior.ColorIndex = 51 'verde51
If Target.Value = "OFICIAL" Or Target.Value = "oficial" Then Target.Interior.ColorIndex = 25 'azul25
If Target.Value = "MAESTRO OFICIAL" Or Target.Value = "maestro oficial" Then Target.Interior.ColorIndex = 3 'rojo
If Target.Value = "SUPERVISOR" Or Target.Value = "supervisor" Then Target.Interior.ColorIndex = 46 'color46
If Target.Value = "JEFE DE PRODUCCION" Or Target.Value = "jefe de produccion" Then Target.Interior.ColorIndex = 1 'negro
If Target.Value = vbNullString Then Target.Interior.ColorIndex = 0
DE ANTEMANO GRACIAS POR EL INTERES.
1 Respuesta
Respuesta de Juan Carlos González Chavarría
-1