Respuesta: Ayuda con un macro en excel 97-2003 Sub cmv13()
UserForm1.Show
Dim Category As String
Dim NCategory As Integer
Dim subcategory As String
Dim NSCategory As Integer
Dim Division As String
Dim NDivision As Integer
Dim SubDivision As String
Dim NSDivision As Integer
Dim count As Integer
Dim count1 As Integer
Dim count2 As Integer
Dim count3 As Integer
Worksheets("Sheet1").Activate
Range("A2:H50").ClearContents
ActiveSheet.Range("A2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
NCategory = InputBox("How many categories are there? : ", "NCategory")
count = NCategory
ActiveSheet.Range("B2").Activate
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = NCategory
End With
Etiqueta_1:
If count = 0 Then
ThisWorkbook.Save
'Application.Quit
'terminar esta parte del macro(recuerda que falta la parte de asignar los codigos de 3 digitos) y salvar el libro automaticamente
End If
ActiveSheet.Range("A2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
Do While count > 0
ActiveSheet.Range("A2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
Category = InputBox("Enter the name of the category: ", "Category")
TSCategory = MsgBox("Has this category Sub-categories?", vbYesNo + vbQuestion, "Sub-Category")
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = Category
End With
count = count - 1
If TSCategory = vbYes Then
GoTo subcategoryprocess
Else
GoTo Etiqueta_1
End If
Loop
subcategoryprocess:
ActiveSheet.Range("C2").Activate
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
NSCategory = InputBox("How many Sub-categories are there? : ", "Number of Sub-Category")
count1 = NSCategory
ActiveSheet.Range("D2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = NSCategory
End With
Etiqueta_2:
If count1 = 0 Then
GoTo Etiqueta_1
End If
ActiveSheet.Range("C2").Activate
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
Do While count1 > 0
ActiveSheet.Range("C2").Activate
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
subcategory = InputBox("Enter the name of the Sub-category : ", "subcategory")
TDivisions = MsgBox("Has this Sub-category Divisions?", vbYesNo + vbQuestion, "Divisions")
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = subcategory
End With
count1 = count1 - 1
If TDivisions = vbYes Then
GoTo divisionprocess
Else
GoTo Etiqueta_2
End If
Loop
If count1 = 0 Then
GoTo Etiqueta_1
Else
GoTo Etiqueta_2
End If
divisionprocess:
ActiveSheet.Range("E2").Activate
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
NDivision = InputBox("How many divisions are there? : ", "Number of Division")
count2 = NDivision
ActiveSheet.Range("F2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = NDivision
End With
Etiqueta_3:
If count2 = 0 Then
GoTo Etiqueta_2
End If
ActiveSheet.Range("E2").Activate
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
Do While count2 > 0
ActiveSheet.Range("E2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
Division = InputBox("Enter the name of the Division : ", "Division")
TSDivision = MsgBox("Does this division Sub-Divisions?", vbYesNo + vbQuestion, "Sub-Divisions")
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = Division
End With
count2 = count2 - 1
If TSDivision = vbYes Then
GoTo subdivisionprocess
Else
GoTo Etiqueta_3
End If
Loop
If count2 = 0 Then
GoTo Etiqueta_2
End If
subdivisionprocess:
ActiveSheet.Range("G2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
NSDivision = InputBox("How many Sub-Divisions are there? : ", "Number of Sub-Division")
count3 = NSDivision
ActiveSheet.Range("H2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = NSDivision
End With
Do While count3 > 0
ActiveSheet.Range("G2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With
SubDivision = InputBox("Enter the name of the Sub-Division : ", "SubDivision")
With ActiveCell
Do While Not IsEmpty(ActiveCell)
.Offset(1, 0).Activate
Loop
.Value = SubDivision
End With
count3 = count3 - 1
Loop
If count3 = 0 Then
GoTo Etiqueta_3
End If
End Sub
este es el codigo de mi programa |