VB.2005 - Exportar una imagen de un picturebox a Excel

[zeroyevi]

si estas usando un datagrid es mas facil


necesitas un boton "boton btnExcel_Click" y un datagrid "DataGrid1"
y cuando muestres los datos en un datagrid esta aplicacion recorre el datagrid , puedes configurarlos


'-----------------------------------------------------------------

Private Sub btnExcel_Click()
On Error GoTo e
MsgBox "la creacion archivo Excel tiene proceso de execucion espere letras Azules", vbInformation, "Informe Colegios sin Sticker"
Call exportar_Datagrid(DataGrid1, DataGrid1.ApproxCount)
Exit Sub
e:
Err.clear
End Sub

Private Sub exportar_Datagrid(DataGrid1 As DataGrid, n_Filas As Long)
btnExcel.Enabled = False
Dim Obj_Excel As Object
Dim Obj_Libro As Object
Dim Obj_Hoja As Object
Dim oFormato As StdDataFormat
Dim palabra As String

Dim i As Integer, j As Integer

If n_Filas = 0 Then
MsgBox "No hay datos para exportar a excel": Exit Sub
Else

'-------------------------------------------------------------------------
' Set Obj_Excel = CreateObject("Excel.Application")
' Set Obj_Libro = Obj_Excel.Workbooks.Add(Path)

'Ponemos la aplicación excel visible
'Obj_Excel.Visible = True

'Hoja activa
' Set Obj_Hoja = Obj_Excel.ActiveSheet
' Set Obj_Hoja = Obj_Excel.worksheets.Add
'----------------------------------------------------------------

Set Obj_Excel = CreateObject("Excel.Application")
Set Obj_Libro = Obj_Excel.workbooks.Add
Set Obj_Hoja = Obj_Excel.worksheets.Add
Obj_Excel.Visible = True
Set Obj_Hoja = Obj_Excel.ActiveSheet

'--------------------------------------------------------

' Recorre el Datagrid
iCol = 0
For i = 0 To DataGrid1.Columns.Count - 1
If DataGrid1.Columns(i).Visible Then
iCol = iCol + 1
'Caption de la columna


Obj_Hoja.Cells(1, iCol) = (UCase(DataGrid1.Columns(i).Caption))

For j = 0 To n_Filas - 1
'asigna el valor a la celda del Excel

x_formato = (DataGrid1.Columns(i).CellValue(DataGrid1.GetBookm ark(j)))

If DataGrid1.Columns(i) = DataGrid1.Columns(3) Then
'palabra = Trim(UCase(x_formato))
'Obj_Hoja.Cells(j + 2, iCol) = "N. " + (palabra)

Obj_Hoja.Cells(j + 2, iCol) = (UCase(x_formato))
Else
Obj_Hoja.Cells(j + 2, iCol) = (UCase(x_formato))


End If

Next

End If
Next

'Opcional : colocamos en negrita y de color rojo los enbezados en la hoja
Obj_Hoja.Rows(1).Font.Bold = True
Obj_Hoja.Rows(1).Font.Color = vbBlue

'Autoajustamos
Obj_Hoja.Columns("A:Z").AutoFit
End If

'Eliminamos las variables de objeto excel
Set Obj_Hoja = Nothing
Set Obj_Libro = Nothing
Set Obj_Excel = Nothing


End Sub