Macro insertar Imagenes en excel
Publicado por Emilio Sánchez (1 intervención) el 20/03/2020 20:06:19
Buenas tardes
Quería por favor si alguien supiera modificar una macro "insertar imágenes"
El funcionamiento de la macro corre perfectamente, esta macro limpia las imágenes (elimina) y las actualiza en la columna "C" desde la carpeta "img" , yo pegue otras imágenes independientes en la columna "Q" y lo que ocurre es que al actualizar las imágenes para que corra la macro me borra también las que están en columna "Q" y eso es lo que quiero evitar, solo tiene que borra y actualizar las imágenes de la columna "C"
Quería por favor si alguien supiera modificar una macro "insertar imágenes"
El funcionamiento de la macro corre perfectamente, esta macro limpia las imágenes (elimina) y las actualiza en la columna "C" desde la carpeta "img" , yo pegue otras imágenes independientes en la columna "Q" y lo que ocurre es que al actualizar las imágenes para que corra la macro me borra también las que están en columna "Q" y eso es lo que quiero evitar, solo tiene que borra y actualizar las imágenes de la columna "C"
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub InsertarImagenes_2()
'Declaramos variablesDim RutaActual As String
Dim RangoImagen As Range
Dim shp As Object
'En caso de error... 'On Error GoTo ManejadorErroresOn Error Resume Next
For Each shp In ActiveSheet.ShapesIf shp.Name = "imagen11" Then
Else
shp.DeleteEnd If
Next
'La variable RutaActual guardará la ruta completa donde está el archivoRutaActual = ThisWorkbook.Path
'Desactivamos la actualización de pantallaApplication.ScreenUpdating = False
'Elegimos la celda B3ActiveSheet.Range("C3").Select
'Recorremos cada fila mientras haya datos en la columna ADo While ActiveCell.Offset(0, -1).Value <> Empty
Set RangoImagen = ActiveCell.Offset(0, -1)
'Insertamos la imagen que corresponda al nombre de la columna AActiveSheet.Pictures.Insert(RutaActual & "\img\" & RangoImagen.Value & ".png").Select
Call FitPic_2
'Activamos la siguiente filaActiveCell.Offset(1, 0).Select
Loop
Range("A2").Select
Application.ScreenUpdating = True
On Error GoTo 0
'Exit Sub 'ManejadorErrores: 'Application.ScreenUpdating = True 'MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "EXCELeINFO"End Sub
Valora esta pregunta
0