En esta entrada veremos cómo llamar a los libros cuando necesitamos invocar su nombre desde una macro, ya sea para capturar información o enviarla a otros libros.
La macro se encuentra en el libro Ventas. Desde el libro Pedido se trae información a éste libro activo y también al libro de Taller. Como segundo paso también moveremos datos entre diferentes hojas del libro Ventas.
En el código siguiente solo dejaré las instrucciones de declaración de variables y un pase como ejemplo. El pegado puede ser como en el ejemplo, 'Paste Special', solo 'Paste' o cualquier otro tipo de pegado como los vistos en el video Nº 71 de mi canal.
Macro ubicada en un módulo del libro VENTAS (libro activo).
NOTA: En el video, la ruta de los libros se toma a partir del libro Ventas, el que contiene la macro. Pero en caso de que se encuentre, por ejemplo, en otro disco (Ej.1) o en un servidor (Ej.2), las instrucciones serían de este modo:
Ejemplo 1:
ruta = "D:\AL_TRABAJO_2023\Javi_Prueba_IMAGENES\Datos\"
nbreLibro = "Consultas Julio.xlsm"
Workbooks.Open (ruta & nbreLibro)
Ejemplo 2:
ruta = "\\EMPRESA\Sucursal1\Depto.Pedidos\Marketing y ventas\"
nbreLibro = "Consultas Julio.xlsm"
Workbooks.Open (ruta & nbreLibro)
Sub Registra_Pedido()
Dim libV As Workbook, libP As Workbook, libT As Workbook
Dim hoV As Worksheet, hoP As Worksheet
Dim hoE As Worksheet
Dim ini As Integer 'filas en hoja Ventas
Dim sFila As Integer 'fila en hoja Entregas
Dim ruta As String
Dim nbreLibro As String
Application.ScreenUpdating = False
'libro y hoja de Ventas
Set libV = ActiveWorkbook
Set hoV = libV.Sheets("Control de Ventas")
Dim libV As Workbook, libP As Workbook, libT As Workbook
Dim hoV As Worksheet, hoP As Worksheet
Dim hoE As Worksheet
Dim ini As Integer 'filas en hoja Ventas
Dim sFila As Integer 'fila en hoja Entregas
Dim ruta As String
Dim nbreLibro As String
Application.ScreenUpdating = False
'libro y hoja de Ventas
Set libV = ActiveWorkbook
Set hoV = libV.Sheets("Control de Ventas")
'se deja la hoja desprotegida y sin filtros
With hoV
.Select
.Unprotect
If .FilterMode = True Then .ShowAllData
'se establece primera fila libre para el registro
With hoV
.Select
.Unprotect
If .FilterMode = True Then .ShowAllData
'se establece primera fila libre para el registro
ini = .Range("B" & Rows.Count).End(xlUp).Row + 1
End With
'libro y hoja de origen (Pedido)
ruta = ThisWorkbook.Path & "/"
'libro y hoja de origen (Pedido)
ruta = ThisWorkbook.Path & "/"
'*** CONTROLAR QUE EXISTA LA CARPETA Y EL LIBRO
On Error Resume Next
midire = ThisWorkbook.Path & "/PEDIDOS REGISTRADOS"
'si la carpeta existe la guarda como ruta
If Dir(midire, vbDirectory) = "" Then
MsgBox "No se encuentra la subcarpeta de Pedidos. El proceso se cancela."
Exit Sub
End If
'se solicita el nombre del Pedido a registrar
'(ver en el módulo 1 otras maneras de obtener ese nbre.)
nbreLibro = InputBox("Ingresa el nro de Pedido para registrar en el libro de Ventas.")
If Dir(midire & "/" & nbreLibro) = "" Then
MsgBox "No se encuentra el libro de Pedidos. El proceso se cancela."
Exit Sub
End If
On Error GoTo 0
'*******
nbreLibro = InputBox("Ingresa el nro de Pedido para registrar en el libro de Ventas.")
If Dir(midire & "/" & nbreLibro) = "" Then
MsgBox "No se encuentra el libro de Pedidos. El proceso se cancela."
Exit Sub
End If
On Error GoTo 0
'*******
Workbooks.Open (ruta & "PEDIDOS REGISTRADOS/" & nbreLibro)
Set libP = ActiveWorkbook
Set hoP = libP.Sheets("Pedido")
'libro y hoja de destino (Taller)
On Error GoTo sinLibroTaller
Workbooks.Open (ruta & "Libro TALLER.xlsm")
Set libT = ActiveWorkbook
On Error GoTo 0
MsgBox "A continuación se procederá a pasar la información del Pedido al Sistema de Ventas.", , "INFORMACIÓN"
'-------------- PASA de LIBRO PEDIDOS a LIBRO VENTAS ------------
libP.Activate
hoP.Select
'pase de campos
hoV.Range("H" & ini) = Range("C7")
hoV.Range("I" & ini) = Range("E7")
'------INSERTA HOJA EN TALLER y se registran campos del PEDIDO--
'rango de la hoja Pedido que será copiado en la nueva hoja de Taller
Range("A66:J160").Copy
libT.Activate
'se agrega una nueva hoja en el libro Taller que se acaba de activar
Sheets.Add After:=Sheets(Sheets.Count)
'el rango se pega a partir de A3 con un pegado especial.
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
'se copìan otros rangos. AHORA LA HOJA ACTIVA ES LA NUEVA DE TALLER
'se indica el origen anteponiendo el objeto 'hoP'
hoP.Range("A24:C32,F24:J32").Copy Destination:=ActiveSheet.[L2]
'se asigna un nombre a la nueva hoja de Taller
ActiveSheet.Name = hoP.Range("C7")
ActiveWorkbook.Save 'guarda y cierra libro Taller
ActiveWorkbook.Close
'------------- Se cierra libro Pedidos quedando activo el libro Ventas ---------
libP.Close True
'------------- PASA DATOS DESDE VENTAS A HOJA auxiliar del mismo libro ---
libV.Activate
Set hoE = libV.Sheets("Entregas")
With hoE
.Select
.Unprotect
End With
'se busca el fin de la tabla, agregando otra fila y redimensionando la misma.
Set tablax = hoE.ListObjects(1)
sFila = tablax.Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
sFila = sFila + 1
miRango = .Range(Cells(6, 2), Cells(sFila, 10)).Address
tablax.Resize Range(miRango)
'pase de datos a la nueva fila
Range("B" & sFila) = hoV.Range("A" & ini)
Range("D" & sFila) = hoV.Range("E" & ini)
Range("D" & sFila).NumberFormat = "m/d/yyyy"
Range("B" & sFila).Select
ActiveSheet.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
'-----------------------------------------------------------------------------------------
'se selecciona la 1ra.hoja de Ventas dejando seleccionada la fila del registro
hoV.Select
ActiveSheet.Range("A" & ini).Select
ActiveSheet.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
'ActiveWorkbook.Save 'opcional
MsgBox "Fin del proceso de captura del Pedido.", , "Información"
Exit Sub
ActiveSheet.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
'ActiveWorkbook.Save 'opcional
MsgBox "Fin del proceso de captura del Pedido.", , "Información"
Exit Sub
sinLibroTaller:
MsgBox "No se encontró el libro Taller en la carpeta activa. El proceso se cancela."
End Sub
Ver video Nº 84 desde aquí.
Descargar el libro de ejemplo desde aquí.
No hay comentarios.:
Publicar un comentario