KEMBAR78
Macros 4 B | PDF | Teaching Methods & Materials | Computers
Scribd
Upload
137 views5 pages

Macros 4 B

This document contains code for several VBA macros in Excel to manage accounting functions like saving journal entries, clearing forms, and configuring account plans and system settings. The code filters journal entry data, copies it between sheets, clears ranges, and adds borders. It also includes dialog boxes to prompt users and validate required fields before saving entries.

Uploaded by

Apaza Huarayo Juan de Dios
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
137 views5 pages

Macros 4 B

This document contains code for several VBA macros in Excel to manage accounting functions like saving journal entries, clearing forms, and configuring account plans and system settings. The code filters journal entry data, copies it between sheets, clears ranges, and adds borders. It also includes dialog boxes to prompt users and validate required fields before saving entries.

Uploaded by

Apaza Huarayo Juan de Dios
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 5

Sub mayor()

Application .ScreenUpdating = False


Criterio = Sheets("MENU").Range("C18").Valve
Sheets("MAYORES").Select
filalibre = Sheets("MAYORES").Range("A1048576").End(xlUp).Row
'Limpiamos
Sheets("MAYORES").Range("A11", Cells(filalibre, 10)).Clear
Sheets("DIARIO").Select
Range("D3").Select
ActiveSheet.ListObjects("tablaLibroDiario").Range.AutoFilter Field:=4, _
Criteria1:=Criterio
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("MAYORES").Select
Range("A10").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Sheets("DIARIO").Range("A1").AutoFilter
Sheets("MAYORES").Range("A1").Select
Application.ScreenUpdating = True
End Sub

Sub SumasySaldos()
Application.ScreenUpdating = False
Sheets("SUMAS Y SALDOS").Select
Range("A11:G1000").Select
Selection.Clear
Selection.Font.Bold = False
Range("B10:C23").Select
Selection.ClearContents

Sheet("DIARIO").Select
Range("A1").Selec
Range("tablaLibroDiario[[CODIGO]:[CUENTA]]").Copy

Sheet("SUMAS Y SALDOS").Select
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'QUITAR DUPLICADOS
ActiveSheet.Range("B10:C10000").RemoveDuplicates Columns:Array(1,2)

FILA_MARGEN = Range("C1048576").End(xlUp).Row
Range("B8", Cells(FILA_MARGEN + 1, 7)).Select
'PONER MARGEN A LO SELECCINADO
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Withs Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBttom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

Range("D10:G10").Select
Selection.AutoFill Destination:=Range("D10", Cells(FILA_MARGEN, 7)),
Type:=xlFillDefault
Range("D10:G10").Select

Cells(FILA_MARGEN + 1, 3).Value = "SUMAS IGUALES"


Range("C1048576").End(xlUp).Select
UF = ActiveCell.Row
ActiveCell.Offset(0, 1).Select
Selection.Formula = "sum(D10:D" & UF - 1 & ")"
ActiveCell.Copy
Range(Cells(UF, 4), Cells(UF, 7)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
'NEGRITA.........
Range(Cells(UF, 1), Cells(UF, 7)).Select
Selection.Font.Bold = True

Range("A1").Selec

Application.ScreenUpdating = True
End Sub

Private Sub BotonGuardar_Click()


Dim MsgError, Listo As String
Dim Fila As Integer
If Sheets("COMPROBANTE").Range("G5") = "" Or
Sheets("COMPROBANTE").Range("E5") = "" Then
MsgError = MsgBox("Celdas Como la Fecha y el Nro de Asiento o
Comprobante debe ser llamado", vbCritical)
Else
Sheets("COMPROBANTE").Activate
Fila = Sheets("DIARIO").Range("A1048576").End(xlUp).Row + 1

ActiveSheet.Range("D10").Select 'codigo del primer registro


'bucle
Do While ActiveCell.Value <> ""
Application.ScreenUpdating = False
'Pasamos datos fijos como no de compr.,fecha etc ajustando nro de
celda
Sheets("DIARIO").Cells(Fila, 1) = ActiveSheet.Range("G5") 'FECHA DE LA
HOJA
Sheets("DIARIO").Cells(Fila, 2) = ActiveSheet.Range("E5") 'NRO
COMPROBANTE
Sheets("DIARIO").Cells(Fila, 3) = ActiveSheet.Range("E6") 'TIPO
COMPROBANTE
Sheets("DIARIO").Cells(Fila, 10) = ActiveSheet.Range("D31") 'NOTAS
'Pasamos los registros, el aiento
Sheets("DIARIO").Cells(Fila, 4) = ActiveCell.Offset(0, 0) 'CODIGO
Sheets("DIARIO").Cells(Fila, 6) = ActiveCell.Offset(0, 2) 'PARCIAL
Sheets("DIARIO").Cells(Fila, 7) = ActiveCell.Offset(0, 3) 'DEBE
Sheets("DIARIO").Cells(Fila, 8) = ActiveCell.Offset(0, 4) 'HABER
Sheets("DIARIO").Cells(Fila, 9) = ActiveCell.Offset(0, 5) 'GOLSA
'incrementamos la variable fila para repetir el bucle
Fila = Fila + 1
'de la selda activa bajamos una celda
ActiveCell.Offset(1, 0).Select
Loop
Sheetc("COMPROBANTE").Activate
Listo = MsgBox("Comprobante guardado", vbInformation) = vbYes
Application.ScreenUpdating = True
End If
End Sub
Private Sub BotonLimpiar_Click()
Dim Preg As Strig
Preg = MsgBox("Desea eliminar contenido del comprobante", vbExclamation +
vbYesNo)
If Preg = vbYes Then
Application.ScreenUpdating = False
Sheets("COMPROBANTE").Activate
Range("E5").Select
Selection.ClearContents

Range("D8:I8").Select
Selection.ClearContents

Range("D10:D27").Select
Selection.ClearContents

Range("F10:I27").Select
Selection.ClearContents

Range("D31:E32").Select
Selection.ClearContents

Range("G5:H5").Select
Selection.ClearContents

Range("A1").Select
Application.ScreenUpdating = True
End If
End Sub

Sub Plan_De_Cuentas()
Dim Pregunta As String
Pregunta = MsgBox("�Desea configurar el Plan de Cuenta?,vbQuestion + vbYesNo")
If Pregunta = vbYes Then
Sheets("PLAN DE CUENTAS").Activate
Range("A1").Select
End If
End Sub

Sub Configuraciones()
Dim Pregunta As String
Pregunta = MsgBox("�Desea acceder a las Configuraciones del sistema?",
vbQuestion + vbYesNo)
If Pregunta = vbYes Then
Sheets("DATOS").Activate
Range("A1").Select
End If
End Sub

Sub Imprimir()
ActiveSheet.PrintPreview
End Sub

You might also like