Saltar al contenido

Duda y desesperación por Macro al modificar varias celdas y pegar imagen por dicha modificación

publicado
Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range
Dim rumbo As String

If Application.Intersect(Target, Range("E4")) Is Nothing Then
    Exit Sub
Else

   Set KeyCells = Range("E4")
   Azi = KeyCells

    If (Azi >= 0 And Azi <= 20) Then
        rumbo = "nn"
        ElseIf (Azi >= 21 And Azi <= 69) Then
            rumbo = "ne"
            ElseIf (Azi >= 70 And Azi <= 110) Then
                rumbo = "ee"
                ElseIf (Azi >= 111 And Azi <= 159) Then
                    rumbo = "se"
                    ElseIf (Azi >= 160 And Azi <= 200) Then
                        rumbo = "ss"
                        ElseIf (Azi >= 201 And Azi <= 249) Then
                            rumbo = "so"
                            ElseIf (Azi >= 250 And Azi <= 290) Then
                                rumbo = "oo"
                                ElseIf (Azi >= 291 And Azi <= 339) Then
                                    rumbo = "no"
                                    ElseIf (Azi >= 340 And Azi <= 360) Then
                                        rumbo = "nn"
                                        Else
                                            MsgBox "Azimut fuera de parámetros aceptables"
                                        End If

   'Imagen-----------------
   
   Range("E7:f13").Select
   Range("E7:f13").Activate
   
   Dim ruta As String
   Dim frm As String
   Dim f As String
   Dim foto As String
   Dim rfo As String
   Dim rfoto As String
   Dim salvar

   f = "f"
   frm = "FM_Flechas"
   rfo = f & rumbo
   rfoto = f & rumbo & ".jpg"
   ruta = frm & "." & f & rumbo
   ruta1 = frm & "." & f & rumbo & ".jpg"
   salvar = "imagen.jpg"

   SavePicture FM_Flechas.fnn.Picture, "imagen.jpg" ' original
   Worksheets("Hoja1").Pictures.Insert("imagen.jpg").Select 'original

            With Selection.ShapeRange
                .LockAspectRatio = msoFalse
                .Top = Range("E7").Top + 1
                .Left = Range("E7").Left + 1
                .Width = Range("E7:f13").Width - 1
                .Height = Range("E7:f13").Height - 2
            End With
            

End If
End Sub

Hola a tod@s

Llevo unos días dándole vueltas al tema, he realizado la pregunta en otras páginas y foros, pero no he tenido suerte y no han sido respondidas, así que ahora acudo a vosotr@s

Para empezar, cabe destacar que no tengo ni idea de programación, y que todo lo que hago, es a base de copiar códigos e intentar adaptarlos a lo que pretendo, de ahí que podáis ver auténticas burradas en mis códigos o que de mil vueltas para llegar a un sitio que con dos pasos se hubiera conseguido de mejor forma

Y ahora al grano

--------------Parte 1

Tengo el anterior código, para empezar deciros que soy guia de montaña, y estoy intentado realizar una hoja de excel que automatice una planificación de una ruta.

En el código, lo que pretendo, es que al cambiar distintas celdas, se ejecuten distintas macros, cosa que por ahora no se hacer, pues el código solo se ejecuta si cambio una sola celda, en concreto la E4, pegando una imagen en el rango E7:E13.

Me gustaría que una vez pegaa la imagen en ese rango, si ahora modifico o introduzco un nuevo dato en la celda E14, se pegue otra imagen en el rango E17:E23

-----------------Parte 2

Bien, en el código he conseguido que al cambiar el valor de la celda E4, me pegue la imagen "fnn" en el rango E7:E13. Pero lo que deseo es que en lugar de ser la imagen "fnn", sea la imagen que me arroje la concatenación de las variables f (f = "f") y rumbro (rumbo = al valor obtenido en función de la cifra introducida en la celda E4)

Las imágenes las tengo en un formulario denominado FM_Flechas, contiene 8 imágenes (fnn, fne, fee, fse, fss, fso. foo, fno) y corresponden a 8 direcciones en función de los grados.

He intentado el siguiente código, que no funciona, donde ruta sería la concatenación de las variables: (frm = FM_Flechas) & "." &(f = "f")
   'SavePicture ruta.Picture, "imagen.jpg"

He intentado el siguiente código, que no funciona, donde ruta sería la concatenación de las variables: (frm = FM_Flechas) & "." &(f = "f") y salvar = "imagen.jpg"

   'SavePicture ruta, salvar

 

He realizado decenas de moficaciones y siempre me arroja diferentes errores, unas veces poniendo partes del código en azul, otras dando el error de "no coinciden los tipos" y poniendo líneas en amarillo. Otras simplemente no realizada nada.

Rogaría alguna ayuda porfisss. Eso sí, recordar que no tengo conocimientos de programación, y si me lo complías mucho, quizás no me entere de loq ue intentéis decirme o explicarme.

Un saludo y muchas gracias

 

Featured Replies

publicado

Vamos a intentarlo, pero para poder cerrar el tema anterior, abre un tema nuevo con las explicaciones y vuelve a subir el archivo con el ejemplo que has subido resuelto de forma manual. Estaré atento a tu nueva consulta.

publicado
  • Autor
Hace 22 horas, Antoni dijo:

He corregido las fórmulas de las columnas G9, G19, G29, G39,......, que a mi modo de ver estaban equivocadas.

Por ejemplo : 

G19=SI(G14>0;SI(G14>G4;G14-G4;SI(G14>G4;G4-G14;SI(G14=G4;0;"")));"")

la he cambiado por:

G19=SI(G14>0;SI(G14>G4;G14-G4;G4-G14);"")

El tema de la pendiente era un problema conceptual por mi parte, al considerar que la subida/bajada era en relación al punto siguiente y no al anterior.  Ahora al ver que la altura inicial va en la celda A8, lo he visto claro, o al menos eso creo.

A ver si es esto.

Has de tener en cuenta que solo se recalcula la representación de la pendiente en la fila que has hecho el cambio.

Solo eliminando las cabeceras intercaladas se podría articular el recalculo hasta el final.

Planificación con AZIMUT y pendiente - copia (1).xlsm 208.53 kB · 2 descargas

¡¡¡ Perfecto !!!
 

Muchísimas gracias Antoni, funciona a la perfección, justo como había deseado.

Un trabajo incrible, alucinante. Sigo sin entender el código aún estando comentado, pero es lo que tiene no tener ni idea.

Vaya, estoy alucinado, es una pasada. Lo dicho, muchísimos e inestimables agradecimientos.

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.