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

[el_trasgu]

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

 

[el_trasgu]

Pues ya he solucionado la parte 1

En lugar de utilizar el sigueinte código:

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

Utilizo el siguiente:

If Target.Address = "$E$4" Then

   código a ejecutar

 elseif Target.Address = "$E$14" Then

   código a ejecutar

 elseif ...

end if

 

Ahora sólo me faltaría la parte de utilizar la variable rumbo para elegir la flecha

 

Un saludo

 

 

[Antoni]

Cita

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

Pues como no subas tu archivo y te expliques sobre él, me parece que aquí te va a pasar lo mismo.

[el_trasgu]

En la columna "Azimut", en el apartado superior que corresponde al rango E4:E6, se supone que hay que meter un rumbo, ese rumbo se obtiene de un mapa físico o bien de un mapa virtual tipo google maps o BaseCamp, pero hay que meterlo a mano, y estará entre 0 y 360 grados
 

Una vez introducida la dirección, mediante unos If Then, relaciono esos grados a unas direcciones geográficas tipo norte, sur, este y oeste (NN, NE, EE, SE, SS, SO, OO, NO)

En un formulario denominado FM_Flechas, tengo 8 imágenes que apuntan a esas 8 direcciones y a las que denomino con la dirección precedida de la f de foto (fnn, fne .... )

Al introducir la dirección, se debería de buscar la flecha correspondiente a esa dirección por mediación de la variable rumbo, que será la que la tenga una vez pasados los if y pegar la flecha en el rango E7:E13

Planificación_Final.xlsm

[Antoni]

SI no te contestan antes, le echaré un vistazo este fin de semana y te digo algo. ??

[el_trasgu]

Muchas gracias Antoni, yo seguiré buscando e intentando cosas

[silver_axe007]

Espero te ayude lo coversado 

Adjun to correccion

 If (azi >= 0 And azi <= 20) Then
        rumbo = "nn"
        SavePicture FM_Flechas.fnn.Picture, "imagen.jpg"
        ElseIf (azi >= 21 And azi <= 69) Then
             SavePicture FM_Flechas.fne.Picture, "imagen.jpg"
            ElseIf (azi >= 70 And azi <= 110) Then
                SavePicture FM_Flechas.fee.Picture, "imagen.jpg"
                ElseIf (azi >= 111 And azi <= 159) Then
                    SavePicture FM_Flechas.fse.Picture, "imagen.jpg"
                    ElseIf (azi >= 160 And azi <= 200) Then
                        SavePicture FM_Flechas.fss.Picture, "imagen.jpg"
                        ElseIf (azi >= 201 And azi <= 249) Then
                            SavePicture FM_Flechas.fso.Picture, "imagen.jpg"
                            ElseIf (azi >= 250 And azi <= 290) Then
                                SavePicture FM_Flechas.foo.Picture, "imagen.jpg"
                                ElseIf (azi >= 291 And azi <= 339) Then
                                    SavePicture FM_Flechas.fno.Picture, "imagen.jpg"
                                    ElseIf (azi >= 340 And azi <= 360) Then
                                       SavePicture FM_Flechas.fnn.Picture, "imagen.jpg"
                                        Else
                                            MsgBox "Azimut fuera de parámetros aceptables"
                                        End If

 

[el_trasgu]

Hace 2 minutos , silver_axe007 dijo:

Espero te ayude lo coversado 

Adjun to correccion

 If (azi >= 0 And azi <= 20) Then
        rumbo = "nn"
        SavePicture FM_Flechas.fnn.Picture, "imagen.jpg"
        ElseIf (azi >= 21 And azi <= 69) Then
             SavePicture FM_Flechas.fne.Picture, "imagen.jpg"
            ElseIf (azi >= 70 And azi <= 110) Then
                SavePicture FM_Flechas.fee.Picture, "imagen.jpg"
                ElseIf (azi >= 111 And azi <= 159) Then
                    SavePicture FM_Flechas.fse.Picture, "imagen.jpg"
                    ElseIf (azi >= 160 And azi <= 200) Then
                        SavePicture FM_Flechas.fss.Picture, "imagen.jpg"
                        ElseIf (azi >= 201 And azi <= 249) Then
                            SavePicture FM_Flechas.fso.Picture, "imagen.jpg"
                            ElseIf (azi >= 250 And azi <= 290) Then
                                SavePicture FM_Flechas.foo.Picture, "imagen.jpg"
                                ElseIf (azi >= 291 And azi <= 339) Then
                                    SavePicture FM_Flechas.fno.Picture, "imagen.jpg"
                                    ElseIf (azi >= 340 And azi <= 360) Then
                                       SavePicture FM_Flechas.fnn.Picture, "imagen.jpg"
                                        Else
                                            MsgBox "Azimut fuera de parámetros aceptables"
                                        End If

 

Muchísimas gracias Andrés, me has salvado la vida.

Llevaba un tiempo comiéndome la cabeza sin encontrar una solución y en diez minutos tú lo has resuelto.

Eres un crack, lo dicho, eternos agradecimientos

[Antoni]

Te dejo lo que he hecho.

Vale para cualquier fila.

Estoy intentando hacerlo de otra manera para plasmar los grados con exactitud.

 

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Rango As Range, Resto As Integer
Application.ScreenUpdating = False
Resto = Target.Row Mod 10
If Resto = 4 And Target.Row > 3 And Target.Address Like "$E$*" Then
   '--
   ActiveSheet.Shapes("F" & Target.Row).Delete
   Select Case Target
      Case "":        Exit Sub
      Case Is <= 20:  SavePicture FM_Flechas.fnn.Picture, "imagen.jpg"
      Case Is <= 70:  SavePicture FM_Flechas.fne.Picture, "imagen.jpg"
      Case Is <= 111: SavePicture FM_Flechas.fee.Picture, "imagen.jpg"
      Case Is <= 160: SavePicture FM_Flechas.fse.Picture, "imagen.jpg"
      Case Is <= 201: SavePicture FM_Flechas.fss.Picture, "imagen.jpg"
      Case Is <= 250: SavePicture FM_Flechas.fso.Picture, "imagen.jpg"
      Case Is <= 291: SavePicture FM_Flechas.foo.Picture, "imagen.jpg"
      Case Is <= 340: SavePicture FM_Flechas.fno.Picture, "imagen.jpg"
      Case Is <= 361: SavePicture FM_Flechas.fnn.Picture, "imagen.jpg"
      Case Else:      MsgBox "Azimut fuera de parámetros aceptables"
   End Select
   '--
   ActiveSheet.Pictures.Insert("imagen.jpg").Select 'original
   With Selection.ShapeRange
      Set Rango = Target.Offset(1).Resize(7, 2)
      .Name = "F" & Target.Row
      .LockAspectRatio = msoFalse
      .Top = Rango.Top + 1
      .Left = Rango.Left + 1
      .Width = Rango.Width - 2
      .Height = Rango.Height - 2
   End With
   '--
   ActiveCell.Select
End If
End Sub

 

[Antoni]

Pues fíjate que ha sido más fácil de lo esperado.

He añadido la hoja AZIMUT hoja con una autoforma agrupada, con el nombre GLOBO, que contiene un círculo, 2 líneas a modo de ejes y una flecha con el nombre AZIMUT que se hace rotar en el momento de copiar.

Te dejo un archivo con un ejemplo, la macro quedaría así.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
If Target.Row Mod 10 = 4 And Target.Row > 3 And Target.Address Like "$E$*" Then
   ActiveSheet.Shapes("F" & Target.Row).Delete
   Sheets("AZIMUT").Shapes("AZIMUT").Rotation = Target
   Sheets("AZIMUT").Range("A1:B7").Copy Target.Offset(1).Resize(7, 2)
   ActiveSheet.Shapes("GLOBO").Name = "F" & Target.Row
   Target.Offset(1).Resize(7, 2).Interior.Color = Target.Interior.Color
End If
End Sub

 

Planificación con AZIMUT exacto.xlsm

[el_trasgu]

Vaya, muchísimas y reiteradas gracias a los dos por vuestra inestimable ayuda

Antoni, tu código me resulta totalmente incomprensible, tanto, que me resulta imposible modificarlo.

En él me encuentro con algún problemilla. Lo de la flecha es un puntazo. Pero en la celda E34 deja de funcionar. De ser posible, debería de seguir pudiendo agregar azimut hasta la celda E660.

Otro pequeño problema, es la limpieza de los datos, en mi hoja había añadido un botón que limpiaba las imágenes, pero en tu caso no logro borrarlas.

 

Pues lo dicho, muchísimas gracias a los dos, eternamiente agradecido

[Antoni]

A la tarde le doy repaso.

[Antoni]

En 20/6/2020 at 11:47 , el_trasgu dijo:

Vaya, muchísimas y reiteradas gracias a los dos por vuestra inestimable ayuda

Antoni, tu código me resulta totalmente incomprensible, tanto, que me resulta imposible modificarlo.

En él me encuentro con algún problemilla. Lo de la flecha es un puntazo. Pero en la celda E34 deja de funcionar. De ser posible, debería de seguir pudiendo agregar azimut hasta la celda E660.

Otro pequeño problema, es la limpieza de los datos, en mi hoja había añadido un botón que limpiaba las imágenes, pero en tu caso no logro borrarlas.

 

Pues lo dicho, muchísimas gracias a los dos, eternamente agradecido

Te adjunto el archivo teniendo en cuenta los cambios de página y el botón para eliminar las imágenes, de todas formas, ¿Sabes que en Imprimir\Configuración\Configurar página se puede repetir unas filas en concreto en cada página sin tener que repetirlas en la hoja? ¿Y que en la pestaña Vista\Ventana\Inmovilizar paneles se pueden inmovilizar filas/columnas para que queden fijas cuando te mueves por la hoja?

En cuanto a lo de la pendiente, técnicamente es muy parecido a lo del rumbo, pero no veo claro su representación, sube de nuevo el archivo con un par o tres ejemplos de cual sería tu idea.

Planificación con AZIMUT exacto.xlsm

[el_trasgu]

Pues más o menos la idea sería la representada en el ejemplo subido ahora. En la celda O4 aparece el porcentaje de la pendiente de ese tramo, y en la celda Q4, una representación gráfico que como sería esa pendiente con un signo + si la pendiente es positiva, y un signo - si la pendiente es negativa. Como puedes ver en la hoja, en excel no me resulta difícil realizar los cálculos, pero en vba, estoy totalmente perdido.

Por cierto, muchísimas gracias.

Sobre lo de inmovilizar paneles si lo sabía, sobre el tema de repetir filas, ni idea.

Generalmente la intención es rellenar las diferentes hojas con los puntos de paso marcados, sobre todo cruces, y luego imprimirlas para llevarlas con uno a la ruta ante posible fallo del GPS

 

Planificación con AZIMUT exacto(2).xlsm

[Antoni]

A ver si me aclaro, pendiente de 0% a 100% va de 0º a 90º, la línea iría de horizontal a vertical. ¿Si❓

Lo que no acabo de ver es lo de la pendiente negativa. Cuando es positiva, cada punto en porcentaje equivale a 0,9º, entiendo que es negativa cuando es superior al 100% y la rotación iría de 270º a 360º, ¿Pero como lo hago si no tengo un valor máximo en %❓

El ejemplo de pendiente que has puesto es de 400%, ¿Que ángulo de rotación le corresponderÍa ❓

De paso te propongo eliminar los signos mas-menos, por los colores rojo-azul de la línea. 

 

 

[el_trasgu]

Hola Antoni

Cuando hablo de pendiente negativa, es por el tramo con relación al punto anterior. O sea:

Si G14:H18, es mayor que G4:H8, la pendiente será de subida.

Si G14:H18, es menor que G4:H8, la pendiente será de bajada.

La pendiente en porcentaje no tiene una transferencia directa a grados. Por eso resulta bantante complicado de calcular, la regla de 3 no sirve. Además, tenemos la impresión de que una cuesta con una inclinación del 100% sería vertical, cuando en realidad casi equivale a un ángulo de 45 grados. Para tener una pendiente vertical, nos tendríamos que ir a un 1000%.

Como imagen para el apartado de la pendiente, no se si sería posible, en lugar de una esfera como en el caso de la dirección, poner un simple ángulo y que se vaya digujando la recta en función del porcentaje.

[Antoni]

Creo que lo he entendido, a ver que se me ocurre.

[Antoni]

Estoy en ello, creo que voy por buen camino.

[el_trasgu]

Muchas gracias Antoni

Te puedo decir que yo me puse varias veces con tu código a ver si logro ponerle lógica, y no hay manera. No entiendo nada.

No entiendo de donde sacas la circunferencia ni la flecha.

No entiendo como coges los datos de la hoja

Bueno, de un código como el mio que tenía decenas de líneas y no funionaba a uno como el tuyo de cuatro líneas hay una sustancial diferencia, jeje

Pues lo dicho, que muchísimas gracias

[qwerty123]

Hola.

En 22/6/2020 at 15:49 , el_trasgu dijo:

La pendiente en porcentaje no tiene una transferencia directa a grados. Por eso resulta bantante complicado de calcular, la regla de 3 no sirve. Además, tenemos la impresión de que una cuesta con una inclinación del 100% sería vertical, cuando en realidad casi equivale a un ángulo de 45 grados. Para tener una pendiente vertical, nos tendríamos que ir a un 1000%

Por si sirve de algo, para calcular el ángulo en función de la pendiente:    =GRADOS(ATAN(pendiente/100))

 

Un saludo.

 

[Antoni]

Hace 2 horas, qwerty123 dijo:

Hola.

Por si sirve de algo, para calcular el ángulo en función de la pendiente:    =GRADOS(ATAN(pendiente/100))

 

Un saludo.

 

Gracias qwerty123, en esa línea estoy. 

[Antoni]

Hace 5 horas, el_trasgu dijo:

Muchas gracias Antoni

Te puedo decir que yo me puse varias veces con tu código a ver si logro ponerle lógica, y no hay manera. No entiendo nada.

No entiendo de donde sacas la circunferencia ni la flecha.

No entiendo como coges los datos de la hoja

Bueno, de un código como el mio que tenía decenas de líneas y no funionaba a uno como el tuyo de cuatro líneas hay una sustancial diferencia, jeje

Pues lo dicho, que muchísimas gracias

Ya te pondré comentarios en la macro para ver si lo vas pillando. ?

[el_trasgu]

Hace 3 horas, qwerty123 dijo:

Hola.

Por si sirve de algo, para calcular el ángulo en función de la pendiente:    =GRADOS(ATAN(pendiente/100))

 

Un saludo.

 

Gracias qwerty123

En la hoja de excel la fórmula que empleo pasar la pendiente a porcentaje, se basa en los metros de ascenso y la distancia:

Porcentaje de Pendiente = Altura / Base * 100

Para calcular el ángulo de la pendiente con la fórmula que has puesto, la cosa se complica, supongo que primero habría que calcular los grados de la misma, creo que sería la siguiente fórmula:

Pendiente en Grados = ArcTangente (Altura / Base)

Una vez obtenidos los grados de la pendiente, se pasaría a utilizar la que has comentado:

Angulo de Pendiente = GRADOS(ATAN(pendiente/100))

 

[Antoni]

Pues ya me contarás.

Planificación con AZIMUT y pendiente.xlsm

[el_trasgu]

Hola Antoni, me sorprendes por la dedicación, ya no se como agradecerlo

Varias cosas, aunque me sabe mal mencionar los errores que encuentro, pues es como buscar los fallos.

La verdad es que siento decir que el tema de la pendiente no va muy fino, pues no se adapta a la información que muestra la celda con el porcentaje de la pendiente (Fila O), Veo que llevas el dato a la hoja 2 celda A13 y luego realizas las fórmulas. No se si el error estará en el mismo cálculo de esas fórmulas, pero a veces me pone bajada cuando en realidad es subida y viceversa.

Observo otro error en la celda G39, aún teniendo la fórmula bien metida como en el resto, no hace los cálculos, está metida pero no calcula, no se si es que estará afectada por algún código de la programación.

Para calcular la altura del primer punto, la altura la meto en la celda A8.

El tema de la brújula con los grados me tiene alucinado, es una pasada como funciona.

Planificación con AZIMUT y pendiente - copia.xlsm