Problema de al generar jpg exporta en blanco

[Alejandro Delgado]

Tengo una macro que al exportar una seccion de excel exporta el rango en blanco sin informacion no se por que aqui el codigo

Sub Descripcion_jpg()

Sheets("Ingreso Productos variables").Select

Dim B As String

B = Range("C43").Value

    If B = 2 Then

    Exit Sub

    End If

Sheets("Descripcion").Select

ActiveSheet.Unprotect ("adctv530")

Dim rgExp As Range: Set rgExp = Range("B22:K42")

Dim archivo As String

archivo = Range("A1").Value

    ''' Copy range as picture onto Clipboard

    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    ''' Create an empty chart with exact size of range copied

    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _

    Width:=rgExp.Width, Height:=rgExp.Height)

    .Name = "ChartVolumeMetricsDevEXPORT"

    .Activate

    End With

    ''' Paste into chart area, export to file, delete chart.

    ActiveChart.Paste

    ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export "C:\Fotos\Todas Descripcion\" & archivo

    ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete


End Sub

[/CODE]

[Antoni]

Pues a mi me funciona perfectamente.

[Alejandro Delgado]

si funciona cuando haces solo una exportación a la vez, cuando haces varias en la misma rutina solo la ultima imagen mantiene la informacion las anteriores aparecen con los nombres y los rangos correctos pero en blanco

[Antoni]

No entiendo lo de "....cuando haces varias exportaciones en la misma rutina..."

El código que has adjuntado solo hace una exportación.

[Alejandro Delgado]

Si ese modulo hace solo una exportación pero tengo varios módulos iguales con diferentes condicionantes que se ejecutan uno tras otro de acuerdo a variables los modulos son iguales lo que cambia son los rangos y los criterios de exportacion

[Alejandro Delgado]

Aqui algunos ejemplos

Sub Medidas_calzado_mujer_jpg()

Sheets("Detalles Web").Select

Dim MyChart As Chart

With Range("H23:M42")


    .CopyPicture Appearance:=xlScreen, Format:=xlPicture


    Set MyChart = ActiveSheet.ChartObjects.Add(10, 10, .Width, .Height).Chart

  End With

MyChart.Paste


MyChart.ChartArea.Border.LineStyle = 0


On Error Resume Next


Dim archivo As String

archivo = Range("A2").Value

MyChart.Export "C:\Fotos\Todas Descripcion\" & archivo


MyChart.Parent.Delete


Set MyChart = Nothing


End Sub[/CODE]

[CODE]Sub Medidas_del_Cuerpo_Mujer_Interior_jpg()
Sheets("Descripcion").Select
Dim MyChart As Chart
With Range("AP5:AW24")

.CopyPicture Appearance:=xlScreen, Format:=xlPicture

Set MyChart = ActiveSheet.ChartObjects.Add(10, 10, .Width, .Height).Chart
End With
MyChart.Paste

MyChart.ChartArea.Border.LineStyle = 0

On Error Resume Next

Dim archivo As String
archivo = Range("A5").Value
MyChart.Export "C:\Fotos\Todas Descripcion\" & archivo

MyChart.Parent.Delete

Set MyChart = Nothing

End Sub[/CODE]

[Antoni]

.

Sigo sin tener problemas, he ejecutado ambas macros mas de 10 veces seguidas.

Te dejo el archivo con el que he trabajado.

Sube tu archivo, y seguiré las macros instrucción a instrucción.

.

Imágenes de rangos.xls

[Alejandro Delgado]

es un poco desordenada mi pagina pero cumple su funcion este es el link ofertAhorro Accesorios_H.xlsm - Google Drive

[Antoni]

He probado con tu archivo, y sigo sin tener problemas, he ejecutado las macros que has adjuntado y me las ejecuta tantas veces como lo solicito y las imágenes generadas son las correctas.

Dos cosas:

• Elimina las instrucciones On Error Resume Next, de esta manera sabrás cual es el error que genera
  
• Elimina las filas sobrantes de las hojas (Hay hojas que tienen mas de 1 millón de filas, de ahí los 25 Mbytes que ocupa el archivo).
  

.