| Re: Macro en Excel
PARTE 4:
Private Sub WEEK_Click()
For i = 0 To 150
If ACCESSLIST.Selected(i) = True Then
ACCESSLIST.Selected(i) = False
End If
Next i
Range("at5").Value = WEEK
Range("ar5").Value = ""
REPORTENTITY.Visible = True
reportarea.Visible = True
SALESCONTESTREPORT.Visible = True
REPORTBYWEEK.Visible = False
REPORTENTITY.SetFocus
End Sub
Private Sub ACCESSLIST_Click()
For i = 0 To 55
If WEEK.Selected(i) = True Then
WEEK.Selected(i) = False
End If
Next i
Range("AR5").Value = ACCESSLIST
Range("at5").Value = ""
REPORTBYWEEK.Visible = True
REPORTENTITY.Visible = False
SALESCONTESTREPORT.Visible = False
REPORTBYWEEK.SetFocus
WEEK.Selected(i) = False
End Sub
Private Sub UserForm_terminate()
protect
Unload Me
ActiveSheet.Shapes("autoshape 1").Visible = True 'para mostrar el mensaje de como obtener un nuevo reporte
End Sub
Private Sub Workbook_Open()
ActiveWindow.DisplayHeadings = False ‘Esconde los numeros de las filas y las letras de las columnas.
Unprotect ‘Procedimiento para desproteger las hojas admin y report. (Module1)
BARRAOUT ‘Procedimiento que hace desaparecer las opciones del menu y solo queda Archivo y Ventana.
Sheets("admin").Select
ActiveSheet.Shapes("PANTALLA").Visible = True
For S = 3 To Sheets.Count ' esconde las hojas a partir de la segunda
Sheets(S).Visible = False
Next S
X = Environ("username") 'asigna a la variable X el valor del usuario de red
For u = 1 To Range("user").Count 'asigna a la variable i el valor de 1 a tantos usuarios como haya
If UCase(X) = UCase(Range("user")(u)) Then 'si X en uppercase es igual a alguno de los usuarios en uppercase
f = Range("feuille")(u) 'asigna a la variable F el valor de hoja de la variable i
Sheets(f).Visible = True 'hace visible la hoja que corresponde a la variable i
End If
Next u
Call search
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
closing
unprotect
Sheets("report").Select
Range("AR10").Select
Selection.ClearContents
ActiveWindow.DisplayHeadings = True
Application.DisplayFullScreen = False 'PARA PONER FULL SCREEN
BARRAIN
Sheets("Admin").Select
ActiveWindow.DisplayHeadings = True
Range("A1").Select
protect
End Sub
Private Sub CommandButton1_Click()
MEMO
End Sub
Sub extractperweek()
unprotect
Sheets("REPORT").Select
Range("ax159:bc210").Select
Selection.ClearContents
Range("C159").Select
Sheets("Database").Range("e5:k7340").AdvancedFilte r Action:=xlFilterCopy, CriteriaRange:=Sheets("REPORT").Range("AR6:AR7"), CopyToRange:=Range("ax158:bc158"), Unique:=False
End Sub
Sub extract_sales_contest() 'para extraer los datos para el sales contest
unprotect
Sheets("REPORT").Select
Range("BV216:CH260").Select 'para borrar los datos viejos
Selection.ClearContents
Sheets("admin").Select 'para transferir la lista de la hoja admin
Range("O1:O155").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("report").Range("BV215"), Unique:=True
Range("P1:P155").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("report").Range("BW215"), Unique:=True
Sheets("REPORT").Select
Range("BV217:BW217").Select 'para desplazar el campo un renglon + arriba
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("BV216").Select
ActiveSheet.Paste
Range("BV216").Select 'PARA CONCATENAR CON LA SEMANA
Do While ActiveCell <> ""
SALESCONTESTLIST = ActiveCell.Value
ActiveCell.Offset(0, 2).FormulaR1C1 = "=CONCATENATE(RC[-1],R5C46)"
ActiveCell.Offset(1, 0).Select
Loop
Range("BY215").Value = "ACTUAL"
Range("BZ215").Value = "FC07"
Range("CA215").Value = "FC08"
Range("CB215").Value = "BP"
Range("CC215").Value = "LY"
Range("CD215").Value = "PY"
Range("BX215").Select
Do While ActiveCell <> ""
salescontestweek = ActiveCell.Value
ACTUAL = Application.VLookup(salescontestweek, Range("database"), 6, False)
FC07 = Application.VLookup(salescontestweek, Range("database"), 7, False)
FC08 = Application.VLookup(salescontestweek, Range("database"), 8, False)
BP = Application.VLookup(salescontestweek, Range("database"), 9, False)
ly = Application.VLookup(salescontestweek, Range("database"), 10, False)
PY = Application.VLookup(salescontestweek, Range("database"), 11, False)
If Not Application.IsNA(ACTUAL) Then
ActiveCell.Offset(0, 1) = ACTUAL
ActiveCell.Offset(0, 2) = FC07
ActiveCell.Offset(0, 3) = FC08
ActiveCell.Offset(0, 4) = BP
ActiveCell.Offset(0, 5) = ly
ActiveCell.Offset(0, 6) = PY
End If
vabas
Loop
Range("BX216").Select 'PARA HACER LOS CALCULOS CONTRA LAS CIFRAS REALES
Do While ActiveCell <> ""
salescontestweek = ActiveCell.Value
ActiveCell.Offset(0, 7).FormulaR1C1 = "=RC[-6]-RC[-3]"
ActiveCell.Offset(0, 8).FormulaR1C1 = "=RC[-7]/RC[-4]"
ActiveCell.Offset(0, 9).FormulaR1C1 = "=RC[-8]-RC[-4]"
ActiveCell.Offset(0, 10).FormulaR1C1 = "=RC[-9]-RC[-4]"
vabas
Loop
Range("BV216:CH260").Select 'PARA COPIAR Y PEGAR VALORES
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("BV216:BV260").Select 'PARA MOVER A LA PRESENTACION
Selection.Copy
Range("C216").Select
ActiveSheet.Paste
Range("G216").Select
ActiveSheet.Paste
Range("K216").Select
ActiveSheet.Paste
Range("CE216:CE260").Select 'PARA COPIAR Y PEGAR LAS CIFRAS
Selection.Copy
Range("E216").Select
ActiveSheet.Paste
Range("CF216:CF260").Select
Selection.Copy
Range("I216").Select
ActiveSheet.Paste
Range("CG216:CG260").Select
Selection.Copy
Range("M216").Select
ActiveSheet.Paste
End Sub
Sub SORT()
Range("C216").Select 'PARA ORDENAR DECRECIENTE
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SORT Key1:=Range("E216"), Order1:=xlDescending, Header:=xlGuess, Orientation:=xlTopToBottom
Range("G216").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SORT Key1:=Range("I216"), Order1:=xlDescending, Header:=xlGuess, Orientation:=xlTopToBottom
Range("K216").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SORT Key1:=Range("M216"), Order1:=xlDescending, Header:=xlGuess, Orientation:=xlTopToBottom
End Sub
FIN PARTE 4 |