علي الشيخ

السلام عليكم ورحمة الله وبركاته

يارب تكونوا جميعا بخير وربنا يجزاكم خير على مساعدتكم المستمره

مشكلتي اخوانى تتلخص في اني بعمل برنامج خاص بشغلي عبارة عن برنامج ادارة للمخزون والموردين والعملاء

استفدت كتير جدا من البرامج الموجودة هنا على المنتدى شفت افكار معينة واستفدت من بعض الاكواد منها لان ما عندى خبرة في الـ في بى ايه

البرنامج كله مرفق وهوضح فكرة البرنامج

البرنامج في االكمبيوتر اللى في الدوام بيفتح بدون مشاكل تظهر انما على جهازي هنا بيظهر مشكلة في تسجيل الدخول للبرنامج

ومشكلة في دوال التفقيط عربي وانجلش ومش عارف اسبابها رغم ان نفس الملف بيفتح على جهاز الشغل تمام

والاوفيس في الاتنين هو هو 2010

فاتمنى تصحيح الاخطاء دي وتجربة البرنامج وتصحيح اخطائه اذا قابلكم اى اخطاء

هو عبارة عن 31 شيت ادخالات يوميه للشهر

فاتورة invoice

وهى للعملاء ودى عندى فيها مشكلة

انا عاوز اعمل ارشيف بحيث انى اقدر ارجع للفواتير دي في اى وقت فاخدت كود من الاخ عبدالله المجرب بيحفظ فواتير كل عميل " هما 3 عملاء " وكل عميل له فولدر بيتحفظ فيه فواتيره تلقائيا

المشكلة اللى فيه انى عاوز احفظ شيت الفاتورة فقط وللاسف الكود بيحفظ الملف كله

ثانيا عندى كود بيجمع الاجمالي من الشيتات كلها واحد من الاخ ابو حنين ومشكلته انه ما يضبط الا على 2003

وكود من الاخ باقشير ومشكلته انى مش عارف احدد له الصفحة اللى ياخد منها الاجمالي هو تلقائيا بياخد من اول صفحة وبما ان الكود بتاع الارشيف بيحفظ الملف كله فكده بقى مشكلة

===========

وعندى شيت للموردين بيتم الترحيل اليه مباشرة من خلال صفحات ال 31 بتاعة الادخالات

مثلا ادخلت اليوم 10 مواد من اتنين موردين

بدخل على شيت ال vendors

بتاع الموردين واختار اسم المورد يظهرلي المواد اللى ادخلتها المفروض انى هعمل لها ارشيف بالطريقة السابق زكرها ولكن نفس المشكلة السابقة انه بيحفظ الملف كله

وايضا انا عندى الكود بياخد اكواد الاصناف اللى هتترحل ومحتاج كود ينقل الكميات تلقائيا ايضاوما عرفت اوصله

===

ايضا مشكلة تحديد الصلاحيات للمستخدمين لا تعمل بكفاءة وايضا مش عارف السبب

ولو امكن كود يخلى البرنامج كله يعمل بشكل full screen

====

عارف ان المشاكل كتيره ولكن اللى يقدر يساعد في اى جزئية منه الله يجزاه خير والله ما يعرف برضو ربنا يكرمه على محاولة المساعدة

ولو اى حد عنده اقتراح يفيدينى حتى لو بالفكرة وانا اعمل على تنفيذها قدر المستطاع ربنا يجزاه خير

ولو في امكانية انى حد يقولي على طريقة عمل فورم معين يساعدني في ضبط دقة الادخالات ربنا يسعده

الملف مرفق بصبغة binary

لو ظهر شاشة الدخول وطلب اليوزر والباس اليوزر admin

pass; 123

store12222.rar

ما شاء الله تبارك الله

الله يعمر بيتك ويجزاك الجنة على مساعدتك

ضبط معايا وهو اللى انا محتاجة وبجد الله يزيدك علم الكود فيه مرونه اضفت موردين واضفت ايام وبيشتغل بشكل مثالي الله يسعدك

دعواتي واحترامي لك ولاهل اليمن الحبيب ربنا يكرمك

السلام عليكم ورحمة الله وبركاته

اتمنى ان شاء الله تكونوا جميعا بالف خير

والله يجزاكم خير مقدما على مساعدتكم

مشكلتي انى عندي برنامج فيه شئ انا مش عارف اعمله

وهو ان عندى 30 شيت خاصة بال30 يوم في الشهر

كل يوم له شيت

وعندى عدد من الموردين ولنفترض انهم 3 لكل مورد شيت

اللى انا عاوز اعمله هو ان في اليوم الاول مثلا اعمل ادخالات لكل الاصناف اللى وصلت من الموردين دول

سواء التلاته قاموا بالتوريد او واحد بس مهما يكن

عاوز بعد ما يتم التوريد وادخال الاصناف بكمياتها في الشيت بتاع اليوم الاول بكتب انا جنبه اسم المورد اللى جاب الصنف لي

وانا عاوزه يترحل تلقائيا لصفحة المورد بتاعه

انا قدرت اعمل كده مع اليوم الاول فقط انما لما ادخل على اليوم التانى عاوز اضيف اصناف جديدة تخص اليوم وفى نفس الوقت تترحل اتوماتيكا لشيت المورد كل حسب اصنافه

=========

دى مشكلة واقفة عقبة في البرنامج بتاعي

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

مع العلم ان الادخالات اللى هتكون في الشيتات الثلاثين مش همسحها هتفضل بداخله

========

يعنى الشرط في الترحيل هو هيكون اسم المورد

وانا اعمل على اوفيس 2010

انا ارفقت ملف مصغر للى عاوزه بالظبط فيه الشيتات من 1 - 30 وهى الخاصة بالادخالات

وعملت 3 شيتيات للموردين

اتمنى اكون قدرت اوصل مشكلتي ويتم حلها باذن الله والله يكركم

Book1.rar

السلام عليكم

الكود التالي يعمل على 2003-2007

Option Explicit

'//////////////////////////////////////////////////////


'  اسم مجلد الملفات

Const FilName As String = "ملفاتي"

'  عنوان خلية الجمع في الملفات

Const Adr As String = "A1"

'//////////////////////////////////////////////////////


Sub kh_SumAllBook()

Dim MyObj, MyObjFol, Obj

Dim xlw As Excel.Workbook

Dim MySheet As Worksheet

Dim iPath As String, iName As String

Dim Last As Long, i As Long

Dim ch As String * 1

ch = Application.PathSeparator

'============================

On Error GoTo Err_kh_Files

'============================

iPath = ActiveWorkbook.Path & ch & FilName & ch

Set MyObj = CreateObject("Scripting.FileSystemObject")

Set MyObjFol = MyObj.GetFolder(iPath)

'============================

Set MySheet = ThisWorkbook.Worksheets("TOTAL")

'============================

With MySheet

    Last = .Cells(Rows.Count, "A").End(xlUp).Row

    .Range("A2").Resize(Last, 3).ClearContents

End With

'============================

kh_Application False

'============================

On Error Resume Next

For Each Obj In MyObjFol.Files

    iName = Obj.Path

    If Not Dir(Obj.Path) = "" Then

        If TestType(CStr(Obj.Name)) Then

            Set xlw = Workbooks.Open(iName)

            With MySheet

                i = i + 1

                .Cells(i + 1, "A").Value = CStr(Obj.Name)

                .Cells(i + 1, "B").Value = CStr(xlw.Worksheets(1).Name)

                .Cells(i + 1, "C").Value = Val(xlw.Worksheets(1).Range(Adr))

            End With

            xlw.Close False

        End If

    End If

Next

On Error GoTo 0

'============================

If i Then MySheet.Range("E2").Value = Evaluate("Sum(" & Range("C2").Resize(i).Address & ")")

'============================

Err_kh_Files:

kh_Application True

If Err Then MsgBox "Err.Number:" & vbCr & Err.Number: Err.Clear

'============================

Set MySheet = Nothing: Set MyObj = Nothing: Set MyObjFol = Nothing


End Sub


Sub kh_Application(mbol As Boolean)

With Application

    .Calculation = IIf(mbol, -4105, -4135)

    .ScreenUpdating = mbol

    .EnableEvents = mbol

End With

End Sub


Function TestType(MyTName As String) As Boolean

Dim MyTyp As String

MyTyp = Mid$(MyTName, InStrRev(MyTName, "."))

TestType = MyTyp Like ".xls*"

End Function

المرفق 2003-2007

kh_sum.rar

عليكم السلام ورحمة الله

الله يكرمك ويزيدك علم ويجزاك خير على مساعدتك

ضبط معاي على 2010 وبيشتغل بشكل كويس وحضرتك والاستاذ ابو حنين كفيتوا ووفيتوا والبرنامجين وصلوني بالضبط للى محتاجة

جعله الله في ميزان حسناتكم

اخي والله الكود عندي يعمل بشكل طبيعي لكن جرب التالي

ـ 1 ) كون مجلد و سمه RR و ضع فيه ملغات شرط ان تكتب في الخلية A1 من كل ملف قيمة معينة

ـ 2 ) انشأ مجلدا آخر و ضع فيه المجلد السابق

ـ 3 ) انشأ ملف اكسل ثم افتحه

ـ 4 ) اذهب الى محرر VB ثم اضف موديل و انسخ فيه الموديل التالي :

Declare Function SearchTreeForFile Lib "IMAGEHLP.DLL" _

(ByVal lpRootPath As String, _

ByVal lpInputName As String, _

ByVal lpOutputName As String) As Long

Public Const MAX_PATH = 260

Public Function FindFile(RootPath As String, _

FileName As String) As String

Dim lNullPos As Long

Dim lResult As Long

Dim sBuffer As String

On Error GoTo FileFind_Error

sBuffer = Space(MAX_PATH * 2)

lResult = SearchTreeForFile(RootPath, FileName, sBuffer)

If lResult Then

lNullPos = InStr(sBuffer, vbNullChar)

If Not lNullPos Then

sBuffer = Left(sBuffer, lNullPos - 1)

End If

FindFile = sBuffer

Else

FindFile = vbNullString

End If

Exit Function

FileFind_Error:

FindFile = vbNullString

End Function

ـ 5 ) اذهب الى صفحة Workbook و افتحها و انسخ الكود الاتالي في الحدث Workbook_Open الكود :

Private Sub Workbook_Open()

ورقة1.Range("A1:A50").ClearContents

Set Files = Application.FileSearch

With Files

.LookIn = ThisWorkbook.Path + "\RR"

.FileName = "*.xls"

If .Execute > 0 Then

For i = 1 To .FoundFiles.Count

ورقة1.Cells(i + 1, 1) = .FoundFiles(i)

Next i

Else

MsgBox "لا يوجد ملفات في المسار" & vbNewLine & ThisWorkbook.Path + "\F", vbInformation, "خطأ"

End If

End With

End Sub

ـ 6 ) أنشأ في الصفحة الاولى من الملف زر و قم بنسخ الكود التالي في هذا الزر :

Private Sub CommandButton1_Click()

LastRow = Cells(Rows.Count, "D").End(xlUp).Row '+ 1

On Error Resume Next

Dim xl As New Excel.Application

Dim xlw As Excel.Workbook

Dim Vr As String

Vr = ThisWorkbook.Path & "\RR"

For n = 1 To 10

Set xlw = xl.Workbooks.Open(Cells(n + 1, 1))

xlw.ورقة1.Range("A1").Select

Cells(LastRow + n, 4).Value = xlw.Application.Range("A1").Value

xlw.Close False

Next

LR = Cells(Rows.Count, "D").End(xlUp).Row

For t = 1 To LastRow

s = LR

Cells(1, 5).Formula = "=Sum(D1:D" & s & ")"

Next

End Sub

الآن احفظ الملف في المجلد الثاني الذي أنشأته و اخرج منه ثم اعد فتحه من جديد فإن وجدت في الصفحة الاولى اسماء الملفات التي وضعتها في المجلد RR فالعمل صحيح ما بقي الا الضغط على الزر

و ان لم تجد . . . . . . . فالله اعلم بالخطأ الذي وقع

مرحبا اخي يارب تكون بخير والله يجزاك الخير ويعطيك الف عافية

السلام عليكم

انا جربت اليوم البرنامج بتاع حضرتك على اوفيس 2003 واشتغل ما شاء الله بمنتهى الجمال ومفيش فيه اى مشاكل

جربت اعدل عليه اى شئ عشان يشتغل معايا على اوفيس 2010 بس ما قدرت تقريبا

فانا جربت برضو اعمله يدويا زى ما حضرتك شرحت ونفس المشكلة تقريبا

هجربة على اوفيس 2007 لو اشتغل معايا يبقى حل المشكلة برضو وربنا يجزاك الف خير

عليكم السلام ورحمة الله وبركاته

الله يجزاك كل خير وتاعبك معايا ربنا يكرمك

انا اضفت الكود واختفت المسج بس ما بيجمع ظهرلي 0 في الخلية بس عشان مش بيظهر اسماء الشيتات زي ما حضرتك قولت

وانا اشتغل على اوفيس 2010

طيب مفيش اى طريقة تخليه يتوافق مع 2010 او طريقة تخلي الكود يشتغل معايا لانه فعلا زى ما انا محتاج

وحاجة اخيرة بس بسال حضرتك عنها ان البرنامج بيجمع بدون ما افتح الشيتات الاخرى تمام؟

عليكم السلام...

الله يجزاك الخير اخي

هو الفكره اللى انا عاوزها تمام بس في مشكلة لما اجي افتح المثال بتاعك

لما اجى افتح بيظهرلي خطا في الكود واعمل دى بج

يكون الكود التالي باللون الاصفر

Set Files = Application.FileSearch

وما بقدر اجمع او اعمل شئ لان لما اضغط احسب ما يسوي شئ

ثانيا ياريت تقولي ده هيقدر يجمع البيانات دى يحسب الخلايا سواء اضافت شيتات اخرى او حذفت؟ يعني بيجمع مهما يكن عدد الملفات في الفولرد؟

ومره تانية اشكرك والله يعطيك الف عافية

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