Ver Mensaje Individual
  #3 (permalink)  
Antiguo 31/08/2009, 08:53
pjose07
 
Fecha de Ingreso: agosto-2009
Mensajes: 3
Antigüedad: 15 años, 4 meses
Puntos: 0
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