Option Compare Database
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
Private Sub Exportar_Click()
Dim rutaPlantilla As String
Dim nuevoExcel As String
Dim miexcel As Object
Dim miHoja As Object
Dim arxiu As String
Dim vtitulo As String
'Cogemos los datos del formulario
vtitulo = Nz(Me.titulo.Value, "")
NOMBRE = Nz(Me.NOMBRE.Value, "")
cantidad = Nz(Me.cantidad.Value, "")
total = Nz(Me.total.Value, "")
'Asignamos la ruta hasta la carpeta donde se guardará el nuevo Excel, se ha de crear una carpeta
nuevoExcel = Application.CurrentProject.Path & "\Nuevoexcel\"
'Cogemos la ruta de la plantilla, se ha de crear una carpeta "PLANTILLAS" donde contendrá la plantilla
rutaPlantilla = Application.CurrentProject.Path & "\PLANTILLAS\Plantilla.xlsx"
'Abrimos la plantilla de Excel
Call ShellExecute(Me.hwnd, "Open", rutaPlantilla, "", "", 1)
'Capturamos la instancia de Excel para poder operar desde Access
Set miexcel = GetObject(rutaPlantilla)
'Cogemos la "Hoja1" de la plantilla, cambiar Hoja1 por el nombre que tenga la pestaña de la hoja
Set miHoja = miexcel.Worksheets("Hoja1")
arxiu = CurrentProject.Path & "\Nuevoexcel\" & vtitulo & ".xlsx"
'Operamos sobre la hoja
With miHoja
.Range("A1").Value = vtitulo
.Range("D7").Value = NOMBRE
.Range("D8").Value = cantidad
.Range("D9").Value = total
End With
'Guardamos el Excel con otro nombre
miexcel.SaveAs nuevoExcel & vtitulo & ".xlsx"
'msgbox
MsgBox "El archivo " & vtitulo & ".xlsx " & "se ha guardado en \Nuevoexcel\", vbInformation + vbSystemModal, "Información"
'Cerramos el archivo creado sin cerrar Excel totalmente si tuvieremas cualquier otro abierto
Dim milibro As Object
Dim esta As Boolean
Dim mifichero As String
esta = False
mifichero = CurrentProject.Path & "\Nuevoexcel\" & vtitulo & ".xlsx"
For Each milibro In miexcel.Application.Workbooks
If milibro.FullName = mifichero Then
esta = True
Else
esta = False
Exit For
End If
Next
If esta = True Then
miexcel.Close
Shell ("taskkill /f /im excel.exe")
Else
miexcel.Close
End If
End If
End Sub