اذهب الي المحتوي
أوفيسنا

مساعدة في تعديل كود

أبو شرف

بواسطه أبو شرف
في منتدى الاكسيل Excel

 مشاركة

الردود الموصى بها

أبو شرف

أبو شرف

قام بنشر
قام بنشر

اخواني الأعزاء لدي نظام مخزني متكامل من حيث العمل ومناسب جدا لنا ولكن هناك مشكلة في الأشارة الخاصة بالسعر في الحقل (H) حيث اني  وبمساعدة جميع اخواني في الموقع اعطيت اشارة (- ) سالبة الى عمليات الشراء , والترجيع  وباقي العمليات كلها هي بأشارة موجبة ولكي استخرج اي رصيد او اي حركة , مجرد اجمع حيث ان السالب مع الموجب يعطيني الرصيد وهذه هي الفكرة من العمل ولكن اشارة اسعر تكون سالبة عند امر شراء وايضا سالبة عند امر ترجيع وهذا ما يجعل لي مشكلة لذلك 

اتمنى من اخواني تعديل العمل ورفع الأشارة من الحق (H) نهائي لذلك  

واكرر لا حتاج سوى رفع الأشارة عند الترحيل من الحقل ( H) لا اكثر 

وهذا هو الكود بالكامل ارجو مساعدتي وانا صار لي اكثر من شهر واكتب بالموقع ولم اجد اي شخص يساعدني في هذا الخصوص علما ان اصل الفاتورة هي للأستاذ خبور المحترم كما ارفق لكم نسخة من البرنامج 

واليكم الكود بعد تعديلات الأصدقاء ................. وفقكم الله 

 

 

Dim KHBOOR As Integer
 
Private Sub Combo_AMIL_Change()
 
End Sub
 
Private Sub Combo_NO_Change()
On Error Resume Next
Dim UU  As String
Dim NN As Integer, S As Integer, R As Integer
If TabStrip1.Value = 0 Then GoTo 1
UU = Combo_NO.Text
Combo_NO.Text = Format(UU, "0000")
For S = 0 To 99
  Me.Controls.Item(S).Text = ""
Next
TextBox43.Text = ""
Combo_AMIL.Text = ""
Label27.Caption = ""
LastRow = Cells(Rows.Count, "E").End(xlUp).Row
NN = 0
For S = 7 To LastRow
    If Cells(S, 3).Text = UU Then
    For R = 1 To 10
        Select Case R
            Case 4
                If ComboBox21.Text = "ÊÑÌíÚ" Or ComboBox21.Text = "ÔÑÇÁ" Then
                    Me.Controls.Item(NN + R - 1).Value = -Cells(S, R + 4).Value
                Else
                    Me.Controls.Item(NN + R - 1).Value = Cells(S, R + 4).Value
                End If
            Case Else
                Me.Controls.Item(NN + R - 1).Value = Cells(S, R + 4).Value
        End Select
       
    Next
    Label27.Caption = Format(Cells(S, 2).Value, "yyyy/mm/dd")
    Combo_AMIL.Text = Cells(S, 4).Value
    ComboBox21.Text = Cells(S, 10).Value
    TextBox85.Text = Cells(S, 11).Value
    TextBox86.Text = Cells(S, 12).Value
    TextBox43 = Val(TextBox43) + Val(Me.Controls.Item(NN + 4))
    NN = NN + 5
    End If
Next
TextBox43 = Format(TextBox43, "#,##0.00")
Label22.Caption = "" & NoToTxt2(Val(TextBox43), "ÏæáÇÑ", "ÓäÊ")
On Error GoTo 0
1 End Sub
 
 
Private Sub CommandButton1_Click()
On Error Resume Next
Dim KH As Integer
Dim S As Long, R As Long
If TabStrip1.Value = 1 Then GoTo 2
KH_NO = Range("ÑÞã_ÇáÝÇÊæÑÉ")(2)
If Combo_AMIL.Text = "" Or ComboBox21.Text = "" Or TextBox85.Text = "" Then GoTo 1
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
KH = 0
M = 0
T = 0
For S = 1 To 20
  If Me.Controls.Item(KH).Text <> "" Then
   For R = 1 To 5
        ' If Me.Controls.Item(KH + R - 1).Text <> "" Then (Êã ÇíÞÇÝ ÍÞ ÇáÕäÝ ááÊÑÍíá ÈÏæäå)
           T = T + 1
         
   Next
   M = M + 1
  End If
  KH = KH + 5
Next
If T / M <> 5 Then
1 MsgBox "áÇ ÊÓÊØíÚ ÇáÊÑÍíá áæÌæÏ ÃÎØÇÁ Ýí ÇáÝÇÊæÑÉ", 524288, "ÊäÈíå"
GoTo 3
End If
'
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
KH = 0
For S = 1 To M
    Cells(LastRow + S, 2) = Date
    Cells(LastRow + S, 3) = KH_NO
    Cells(LastRow + S, 4) = Combo_AMIL.Text
    Cells(LastRow + S, 10) = ComboBox21.Text
    Cells(LastRow + S, 11) = TextBox85.Text
    Cells(LastRow + S, 12) = ComboBox22.Text
Cells(LastRow + S, 5) = Me.Controls.Item(KH).Value
Cells(LastRow + S, 6) = Me.Controls.Item(KH + 1).Value
If ComboBox21.Text = "ÊÑÌíÚ" Or ComboBox21.Text = "ÔÑÇÁ" Then
     For R = 3 To 5
         Cells(LastRow + S, R + 4) = "-" & Me.Controls.Item(KH + R - 1).Value
     Next
             Else
                 For R = 3 To 5
                 Cells(LastRow + S, R + 4) = Me.Controls.Item(KH + R - 1).Value
         Next
        End If
   KH = KH + 5
Next
If MsgBox(" Êã ÇáÊÑÍíá ÈäÌÇÍ" _
         & Chr(13) & Chr(13) & "åá ÊÑíÏ ØÈÇÚÉ ÇáÝÇÊæÑÉ ¿¿¿", vbYesNo + vbQuestion + vbMsgBoxRight, "ÊÃßíÏ ØÈÇÚÉ ") = vbYes Then
2        KHBOOR = InputBox("ÝÖáÇð  ÃÏÎá  ÚÏÏ äÓÎ ÇáÇæÑÇÞ ÇáÐí ÊÑíÏåÇ  " & Chr(13) & Chr(13) & "ÇáÇÝÊÑÇÖí äÓÎÉ æÇÍÏÉ", "ÚÏÏ ÇáäÓÎ", "1")
         KH_PRINT
End If
End
On Error GoTo 0
3 End Sub
Private Sub KH_PRINT()
On Error Resume Next
Dim MM As Integer, SS As Integer
MM = 0
For SS = 1 To 20
      Me.Controls.Item(MM).ShowDropButtonWhen = 0
   MM = MM + 5
Next
With Me
   .Height = 520
   .ScrollBars = 0
   .CommandButton1.Visible = False
   .TabStrip1.Visible = False
   .Combo_AMIL.ShowDropButtonWhen = 0
End With
 
Do Until KHBOOR = 0
   Me.PrintForm
   KHBOOR = KHBOOR - 1
Loop
On Error GoTo 0
End Sub
 
Private Sub CommandButton2_Click()
Dim i As Integer
Dim cl As Range
Dim KH As Integer
Dim S As Long, R As Long
If Combo_AMIL.Text = "" Or ComboBox21.Text = "" Then
    MsgBox "áÇ ÊÓÊØíÚ ÇáÊÑÍíá áæÌæÏ ÃÎØÇÁ Ýí ÇáÝÇÊæÑÉ", 524288, "ÊäÈíå"
    GoTo 2
End If
For Each cl In Range("C7:C" & Cells(Rows.Count, "C").End(xlUp).Row)
If cl.Value = Val(Combo_NO) Then
For i = 1 To Application.CountIf(Range("C7:C" & Cells(Rows.Count, "C").End(xlUp).Row), Val(Combo_NO))
'-------------
KH = 0
M = 0
T = 0
For S = 1 To 20
  If Me.Controls.Item(KH).Text <> "" Then
   For R = 1 To 10
     If Me.Controls.Item(KH + R - 1).Text <> "" Then
       T = T + 1
     End If
   Next
   M = M + 1
  End If
  KH = KH + 5
Next
 
If T / M <> 5 Then
'  1 MsgBox "áÇ ÊÓÊØíÚ ÇáÊÑÍíá áæÌæÏ ÃÎØÇÁ Ýí ÇáÝÇÊæÑÉ", 524288, "ÊäÈíå"
'  GoTo 2
End If
'
LastRow1 = cl.Row
KH = 0
'*******************************************************************
' When Items = 1
If M = 1 Then
        For S = 0 To M - 1
            Cells(LastRow1 + S, 2) = Date
            Cells(LastRow1 + S, 4) = Combo_AMIL.Text
            Cells(LastRow1 + S, 10) = ComboBox21.Text
            Cells(LastRow1 + S, 11) = TextBox85.Text
        '    Cells(LastRow1 + S, 12) = TextBox86.Text
        Cells(LastRow1 + S, 5) = Me.Controls.Item(KH).Value
        Cells(LastRow1 + S, 6) = Me.Controls.Item(KH + 1).Value
            If ComboBox21.Text = "ÊÑÌíÚ" Or ComboBox21.Text = "ÔÑÇÁ" Then
                 For R = 3 To 5
                     Cells(LastRow1 + S, R + 4) = Me.Controls.Item(KH + R - 1).Value
                 Next
            Else
                For R = 3 To 5
                    Cells(LastRow1 + S, R + 4) = Me.Controls.Item(KH + R - 1).Value
                 Next
            End If
            KH = KH + 5
        Next
Else
        For S = 0 To M - 2
            Cells(LastRow1 + S, 2) = Date
            Cells(LastRow1 + S, 4) = Combo_AMIL.Text
            Cells(LastRow1 + S, 10) = ComboBox21.Text
            Cells(LastRow1 + S, 11) = TextBox85.Text
        '    Cells(LastRow1 + S, 12) = TextBox86.Text
        Cells(LastRow1 + S, 5) = Me.Controls.Item(KH).Value
        Cells(LastRow1 + S, 6) = Me.Controls.Item(KH + 1).Value
            If ComboBox21.Text = "ÊÑÌíÚ" Or ComboBox21.Text = "ÔÑÇÁ" Then
                 For R = 3 To 5
                     Cells(LastRow1 + S, R + 4) = Me.Controls.Item(KH + R - 1).Value
                 Next
            Else
                For R = 3 To 5
                    Cells(LastRow1 + S, R + 4) = Me.Controls.Item(KH + R - 1).Value
                 Next
            End If
            KH = KH + 5
        Next
End If
'*******************************************************************
LastRow1 = LastRow1 + 1
 
'--------------
 
Next
Exit For
End If
 
 
Next
2 End Sub
 
Private Sub Label40_Click()
 
End Sub
 
Private Sub Label2_Click()
 
End Sub
 
Private Sub Label37_Click()
 
End Sub
 
Private Sub SpinButton1_SpinDown()
Dim Y As Date
Y = Label27.Caption
Label27.Caption = Format(Y - 1, "yyyy/mm/dd")
End Sub
Private Sub SpinButton1_SpinUp()
Dim Y As Date
Y = Label27.Caption
Label27.Caption = Format(Y + 1, "yyyy/mm/dd")
End Sub
Private Sub TabStrip1_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
Dim NN As Integer, S As Integer, R As Integer
Dim MM As Integer, SS As Integer
'If TabStrip1.Value = 1 Then GoTo 1
NN = 0
TextBox43.Text = ""
MM = 2
For SS = 1 To 20
   If Me.Controls.Item(MM).Text <> "" Then
          Me.Controls.Item(MM + 2).Value = Val(Me.Controls.Item(MM).Text) * Val(Me.Controls.Item(MM + 1).Text)
          TextBox43 = Val(TextBox43) + Val(Me.Controls.Item(MM + 2))
   End If
   MM = MM + 5
Next
Label22.Caption = "" & NoToTxt2(Val(TextBox43), "ÏíäÇÑ", "ÝáÓ")
TextBox43 = Format(TextBox43, "#,##0.00")
On Error GoTo 0
1 End Sub
 
Private Sub TextBox5_Change()
 
End Sub
 
Private Sub TextBox85_Change()
 
End Sub
 
Private Sub UserForm_Activate()
On Error Resume Next
Dim NN As Integer, S As Integer, R As Integer
If TabStrip1.Value = 0 Then
   NN = 0
   For S = 1 To 20
      Me.Controls.Item(NN).RowSource = "ÑÞã_ÇáÕäÝ"
      Me.Controls.Item(NN).ShowDropButtonWhen = 2
      NN = NN + 5
   Next
   Label27.Caption = Format(Date, "yyyy/mm/dd")
   Combo_NO.Text = Format(Range("ÑÞã_ÇáÝÇÊæÑÉ")(2), "0000")
   Combo_NO.Locked = True
   CommandButton2.Enabled = False
ElseIf TabStrip1.Value = 1 Then
    Combo_NO.ShowDropButtonWhen = 2
    Combo_NO.Clear
    
   NN = 0
   For S = 1 To 20
      Me.Controls.Item(NN).RowSource = "ÑÞã_ÇáÕäÝ"
      Me.Controls.Item(NN).ShowDropButtonWhen = 2
      NN = NN + 5
   Next
    
    LastRow = Cells(Rows.Count, "C").End(xlUp).Row
    
    For R = 7 To LastRow
       If Application.WorksheetFunction.CountIf(Range("C7:C" & R), Cells(R, 3).Value) = 1 Then
          Combo_NO.AddItem Cells(R, 3)
      End If
   Next
   SpinButton1.Visible = False
   CommandButton1.Caption = "ØÈÇÚÉ"
   Combo_AMIL.ShowDropButtonWhen = 0
   ComboBox21.ShowDropButtonWhen = 0
   Combo_NO.ShowDropButtonWhen = 2
   Combo_NO.SetFocus
End If
On Error GoTo 0
End Sub
 
 

فاتورة حركة بضاعة.rar

أبو حنــــين

أبو حنــــين

قام بنشر
قام بنشر

السلام عليكم

اذا كان الامر  فقط هو تغيير الاشارة في العمود H

يمكنك كتابة الكود التالي في ورقة نظام مبيعات كما يلي

 

Private Sub Worksheet_Change(ByVal Target As Range)

Dim LR As Long, cl As Range
    LR = Cells(Rows.Count, "H").End(xlUp).Row
        For Each cl In Range("H2:H" & LR)
        If cl < 0 Then cl = Abs(cl)
    Next
    
End Sub
أبو شرف

أبو شرف

قام بنشر
  • الكاتب
قام بنشر

استاذنا الغالي ابو حنين عجججججججججججججججججججججججججز لساني على شكرك وانت قمت بشيء صدقني ليس بقليل , انت احييت نظام مخازن كامل لمجموعة شركات بعملك هذا ,,,, لا استطيع ان اقول اي شيء سوى (( لله درك )) ووفقك الله وسترك واغناك وعافاك وانشاء الله دائما في تقدم ورزق وصحة وتحقيق جميع الأمنيات 

اخوك 

ابو شرف 

وتحية الى كافة الأخوة الأعضاء والمشرفين على هذا الموقع العملاق 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept