MACRO con opcion a escribir los archivos y poner SONIDO al finalizar la carga de consumos
MACRO Cargar Consumos", dicha macro esta colocada en el Libro "01_2015 MP CREA KX.xls", por favor te pido agregar la opcion de poder tipear el "nombre del Libro" y el "nombre de la hoja" (desde donde vienen los datos de consumo, ya que varian mes a mes). Tambien agrega un sonido de SIRENA que avise que el proceso a finalizado, a continuacion dejo el codigo VBA
Sub CARGAR_CONSUMOS()
Set INC = Application.InputBox("INDIQUE DONDE COMENZAR LA CARGA DE DATOS", , , , , , , 8) 'DONDE VAN LOS DATOS
INC.Select
Application.Windows("FORMATOS DE TRABAJO.xlsm").Activate
Set INICIO = Application.InputBox("INDIQUE EL INICIO DE LOS DATOS", , , , , , , 8) 'ORIGEN DE DATOS
INICIO.Select
While ActiveCell <> ""
If ActiveCell <> 0 Then
FILA = ActiveCell.Row
CONSUMO = ActiveCell
CONSUMO = ActiveCell
MP = Range("B" & FILA)
CODIGO = Range("A" & FILA)
FAMILIA = Range("C" & FILA)
GRUPO = Range("D" & FILA)
ARTICULO = Range("E" & FILA)
UNIDAD = Range("J" & FILA)
Application.Windows("01_2015 MP CREA KX.xls" ).Activate
ActiveCell = CONSUMO
ActiveCell.Offset(0, -22) = MP
ActiveCell.Offset(0, -21) = CODIGO
ActiveCell.Offset(0, -20) = ARTICULO
ActiveCell.Offset(0, -19) = UNIDAD
ActiveCell.Offset(0, -18) = FAMILIA
ActiveCell.Offset(0, -17) = GRUPO
ActiveCell.Offset(1, 0).Select
End If
Application.Windows("FORMATOS DE TRABAJO.xlsm ").Activate
ActiveCell.Offset(1, 0).Select
Wend
Sirena ‘sonido de sirena que avise el fin del proceso
End SubEstare pendiente de tu respuesta.
1 Respuesta
Respuesta de Dante Amor
1
Te anexo la macro actualizada
Public Declare Function Beep Lib "kernel32" _
(ByVal dwFreq As Long, _
ByVal dwDuration As Long) As Long
'
Sub CARGA_CONSUMOS()
Set l1 = ThisWorkbook
Set INC = Application.InputBox("INDIQUE DONDE COMENZAR LA CARGA DE DATOS", , , , , , , 8) 'DONDE VAN LOS DATOS
INC.Select
'Application.Windows("FORMATOS DE TRABAJO.xlsm").Activate
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "xls.*", "*.xls*"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path & "\"
'.Show
If Not .Show Then Exit Sub
Set l2 = Workbooks.Open(.SelectedItems.Item(1), ReadOnly:=True)
End With
Set INICIO = Application.InputBox("INDIQUE EL INICIO DE LOS DATOS", , , , , , , 8) 'ORIGEN DE DATOS
INICIO.Select
While ActiveCell <> ""
If ActiveCell <> 0 Then
FILA = ActiveCell.Row
CONSUMO = ActiveCell
CODIGO = Range("G" & FILA)
MPRIMA = Range("D" & FILA)
FAMILIA = Range("E" & FILA)
GRUPO = Range("F" & FILA)
ARTICULO = Range("H" & FILA)
PRESENTACION = Range("L" & FILA)
UMEDIDA = Range("M" & FILA)
l1.Activate
ActiveCell = CONSUMO
ActiveCell.Offset(0, -22) = MPRIMA
ActiveCell.Offset(0, -21) = CODIGO
ActiveCell.Offset(0, -20) = ARTICULO
ActiveCell.Offset(0, -19) = PRESENTACION
ActiveCell.Offset(0, -18) = FAMILIA
ActiveCell.Offset(0, -17) = GRUPO
ActiveCell.Offset(0, -13) = UMEDIDA
ActiveCell.Offset(1, 0).Select
End If
l2.Activate
ActiveCell.Offset(1, 0).Select
Wend
l2.Close
Beep 880, 300
MsgBox "FIN DEL PROCESO"
'SIRENA 'SONIDO DE SIRENA QUE AVISE EL FIN DEL PROCESO
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
¡Gracias! Funciona mucho mejor de lo que esperaba, ya que solo pedí escribir el nombre del archivo y tu le has agregado que dándole clic ubique mediante el buscador la ubicación del archivo que contiene los datos, quedo super bien, y como siempre te estoy muy agradecido, saludos, JOHNMOR41
