locked
Apagar Foto da Autoforma RRS feed

  • Pergunta

  • Bom dia a todos. O que estou precisando é o seguinte. 
    O código abaixo, ele carrega imagem de acordo com o valor inserido na célula J4. 
    
    Sub Fotos() 
    Dim Imagem As Shape
    Dim WkSheet As Worksheet 
    Dim Nome As String 
    Nome = Range("J4") 
    Set WkSheet = ActiveSheet 
    Set Imagem = WkSheet.Shapes("Retângulo 3") Imagem.Fill.UserPicture "J:\Beneficiamento\Gestão\Treinamentos\Fotos\" & Nome & ".JPG" 
    End Sub 
    
    O que eu queria é que quando a célula J4 estiver sem nenhum valor ( vazia ), 
    apagasse a foto que esta na Autoforma. 
    Eu alterei o Código assim.. mais não esta funcionando. 
    
    Sub Fotos() 
    If Range("J4") = "" Then
     Shape ("Retângulo 3").value = "" 
    Exit Sub 
    End If 
    ElseIf Range("J4") <> "" Then 
    Dim Imagem As Shape 
    Dim WkSheet As Worksheet 
    Dim Nome As String 
    Nome = Range("J4") 
    Set WkSheet = ActiveSheet 
    Set Imagem = WkSheet.Shapes("Retângulo 3") Imagem.Fill.UserPicture "J:\Beneficiamento\Gestão\Treinamentos\Fotos\" & Nome & ".JPG"
    End If
    End Sub 
    
    Muito Obrigado a todos.. 
    Tenham um ótimo dia.
    

    ...
    quinta-feira, 13 de agosto de 2009 13:57

Respostas

  • Faça assim

    Sub Fotos_()
        If Range("J4") = "" Then
            ActiveSheet.Shapes("Rectangle 1").Select
            Selection.ShapeRange.Fill.Visible = msoFalse
            Selection.ShapeRange.Fill.Solid
            Selection.ShapeRange.Fill.Transparency = 0#
            Selection.ShapeRange.Line.Weight = 0.75
            Selection.ShapeRange.Line.DashStyle = msoLineSolid
            Selection.ShapeRange.Line.Style = msoLineSingle
            Selection.ShapeRange.Line.Transparency = 0#
            Selection.ShapeRange.Line.Visible = msoTrue
            Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
            Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
            Exit Sub
        ElseIf Range("J4") <> "" Then
            Dim Imagem As Shape
            Dim WkSheet As Worksheet
            Dim Nome As String
            Nome = Range("J4")
            Set WkSheet = ActiveSheet
            Set Imagem = WkSheet.Shapes("Retângulo 1")
                Imagem.Fill.UserPicture "D:\Fotos\" & Nome & ".JPG"
        End If
    End Sub

    Testei e deu certo

    Wesley
    • Marcado como Resposta Alvinhoo quinta-feira, 20 de agosto de 2009 12:00
    segunda-feira, 17 de agosto de 2009 23:03

Todas as Respostas

  • Faça assim

    Sub Fotos_()
        If Range("J4") = "" Then
            ActiveSheet.Shapes("Rectangle 1").Select
            Selection.ShapeRange.Fill.Visible = msoFalse
            Selection.ShapeRange.Fill.Solid
            Selection.ShapeRange.Fill.Transparency = 0#
            Selection.ShapeRange.Line.Weight = 0.75
            Selection.ShapeRange.Line.DashStyle = msoLineSolid
            Selection.ShapeRange.Line.Style = msoLineSingle
            Selection.ShapeRange.Line.Transparency = 0#
            Selection.ShapeRange.Line.Visible = msoTrue
            Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
            Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
            Exit Sub
        ElseIf Range("J4") <> "" Then
            Dim Imagem As Shape
            Dim WkSheet As Worksheet
            Dim Nome As String
            Nome = Range("J4")
            Set WkSheet = ActiveSheet
            Set Imagem = WkSheet.Shapes("Retângulo 1")
                Imagem.Fill.UserPicture "D:\Fotos\" & Nome & ".JPG"
        End If
    End Sub

    Testei e deu certo

    Wesley
    • Marcado como Resposta Alvinhoo quinta-feira, 20 de agosto de 2009 12:00
    segunda-feira, 17 de agosto de 2009 23:03
  • Wesley, perfeito.
    Era isso mesmo que queria.
    Muito Obrigado
    ...
    quinta-feira, 20 de agosto de 2009 12:00