Ver Mensaje Individual
  #7 (permalink)  
Antiguo 30/04/2010, 11:57
shantyeunais
 
Fecha de Ingreso: abril-2010
Mensajes: 4
Antigüedad: 14 años, 9 meses
Puntos: 0
Respuesta: Ayuda para formato de factura

Cita:
Iniciado por GEMO Ver Mensaje
Por cierto, en las políticas del foro esta el no escribir con mayúsculas ya que se interpreta como si estuvieras gritando o exigiendo algo je, al principio me sucedió lo mismo, saludos bye
ok gemo muchas gracias por toda tu ayuda y perdon que moleste con otra duda pero ya intente como me dijiste anteriormente pero no encontre en la macro la parte esa donde dice "nuevos soles" para cambiarlo a "pesos"... o alvez me esta fallando la vista... jejeje...
pero de todas formas gracias por todo....(ah y los siento por lo del escrito anterior fue de emocion gracias!)
ah y estod son los codigos de la macro:

Dim strcod$, strrango$
Dim lngvalorstock&, lngcant&

Sub Controlpartes()

Dim strdescrip$, strmed$, strtipo$
Dim lngnuevovalor&, lngnumero&
Dim dathoy As Date

Application.ScreenUpdating = False

If [E5] = "" Or [E8] = "" Or [E9] = "" Then
MsgBox "No deje ningun campo vacio", vbExclamation + vbOKOnly, "CAMPO VACIO"
Application.ScreenUpdating = True
Exit Sub
End If

lngnumero& = [B2]: strcod$ = [E5]: strdescrip$ = [E6]
strmed$ = [E7]: lngcant& = [E8]: strtipo$ = [E9]
dathoy = Date

Sheets("Stock").Select
[B1].Select
lngvalorstock& = [B:B].Find(What:=strcod$, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(0, 4).Value

strrango$ = [B:B].Find(What:=strcod$, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(0, 4).Address

If strtipo$ = "Salida" Then

If lngvalorstock& < lngcant& Then
MsgBox "El stock de " & strdescrip$ & " es menor (" _
& lngvalorstock& & ") al de su parte (" & lngcant& & ")", vbExclamation + vbOKOnly, "STOCK MENOR"
Sheets("Partes").Select
Application.ScreenUpdating = True
Exit Sub
End If

Range(strrango$) = lngvalorstock& - lngcant&
lngnuevovalor& = Range(strrango$)
End If

If strtipo$ = "Entrada" Then
Range(strrango$) = lngcant& + lngvalorstock&
lngnuevovalor& = Range(strrango$)
End If

Sheets("Control_Partes").Select

[B65536].End(xlUp).Offset(1, 0) = lngnumero&
[B65536].End(xlUp).Offset(0, 1) = strcod$
[B65536].End(xlUp).Offset(0, 2) = strdescrip$
[B65536].End(xlUp).Offset(0, 3) = strmed$
[B65536].End(xlUp).Offset(0, 4) = lngcant&
[B65536].End(xlUp).Offset(0, 5) = strtipo$
[B65536].End(xlUp).Offset(0, 6) = dathoy

MsgBox "Su stock de " & strdescrip$ & " fue actualizado de " _
& lngvalorstock& & " a " & lngnuevovalor&, vbExclamation + vbOKOnly, "STOCK ACTUALIZADO"

Sheets("Partes").Select
[E5,E8,E9].ClearContents
[B2] = [B2] + 1

Application.ScreenUpdating = True

End Sub

Sub Factura()

Dim lngcontarproduc&, bitvueltas As Byte, bitvueltas2 As Byte

On Error GoTo hojaerror

Application.ScreenUpdating = False

If [C7] = "" Then
MsgBox "Ingrese el cliente", vbExclamation + vbOKOnly, _
"CLIENTE FALTANTE"
[C7].Select
Application.ScreenUpdating = True
Exit Sub
End If

lngcontarproduc& = Application.WorksheetFunction.CountA([B14:B23])

If lngcontarproduc& <= 0 Then
MsgBox "Ingrese al menos un producto en su factura", vbExclamation + vbOKOnly, _
"INGRESE PRODUCTOS"
Application.ScreenUpdating = True
Exit Sub
End If

[B14].Select

For bitvueltas = 1 To lngcontarproduc&

strcod$ = ActiveCell: lngcant& = ActiveCell.Offset(0, 3).Value
Sheets("Stock").Select
[B1].Select

lngvalorstock& = [B:B].Find(What:=strcod$, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(0, 4).Value

strrango$ = [B:B].Find(What:=strcod$, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(0, 4).Address

Range(strrango$) = lngvalorstock& - lngcant&

Sheets("Factura").Select
ActiveCell.Offset(1, 0).Select

Next bitvueltas

Sheets("Impresion").PrintOut Copies:=1, Collate:=True

[B14].Select

For bitvueltas2 = 1 To lngcontarproduc&

[B3].Copy
Sheets("Control_Facturas").Select
[B65536].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Factura").Select

[C7:C10].Copy
Sheets("Control_Facturas").Select
[C65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

Sheets("Factura").Select
Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy

Sheets("Control_Facturas").Select
[C65536].End(xlUp).Offset(0, 4).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False

Sheets("Factura").Select
ActiveCell.Offset(1, 0).Select

Next bitvueltas2

[C7,B14:B23,E14:E23].ClearContents
[B3] = [B3] + 1

Application.ScreenUpdating = True

Exit Sub