Hamdi Edlbi-khalf

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

السلام عليكم حاجتك في هذا الفيديو و لو كنتُ متصلاً عبر الحاسب لوضع لك مثالاً . ملاحظة أثناء تطبيق الطريقة و الحصول على اسم الطابعة ربما تختلف النتيجة مع اختلاف الحاسب لذلك ستضطر إلى إعادة عملية الحصول على اسم الطابعة مع كل حاسب الإرسال إلى OneNote هو عملياً إرسال الملف إلى طابعة. جزى الله خيراً السيدة ساجدة

السلام عليكم انظر في هذا الرابط ستجد فيه حاجتك و أعتذر لا أستطيع التعديل على ملفك كوني اتصل من الجوال

أعتذر لإساءة فهمي لسؤالك لكن الطريقة - على ما أعتقد - هي باللجوء إلى كود الأستاذ @أبو إبراهيم الغامدي أتمنى لك التوفيق

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

السلام عليكم أعتذر على التأخر لكن جهاز تعطل أخي الفاضل الكود الذي قدمته بحاجة إلى ملف إكسل أعددته أولاً لترحل إليه البيانات قمت بالتعديل على الكود Option Compare Database Option Explicit Private Sub Command2_Click() Dim strFile As String Dim varItem As Variant strFile = InputBox("Designate the path and file name to export to...", "Export") If (strFile = vbNullString) Then Exit Sub For Each varItem In Me.List0.ItemsSelected DoCmd.TransferSpreadsheet transferType:=acExport, _ spreadsheetType:=acSpreadsheetTypeExcel9, _ tableName:=Me.List0.ItemData(varItem), _ fileName:=strFile Next MsgBox "Process complete.", vbOKOnly, "Export" End Sub Private Sub Form_Open(Cancel As Integer) Dim strTables As String Dim tdf As TableDef For Each tdf In CurrentDb.TableDefs If (Left(tdf.Name, 4) <> "MSys") Then strTables = strTables &";"&tdf.Name End If Next Me.List0.RowSource = strTables End Sub و لكي يعمل الكود عليك أولاً اختيار أسماء الجداول من مربع القائمة ( يجب أن تجعل Row source type= Value list Multi select = extended ) ثم حدد أسماء الجداول التي ترغب بترحيلها ثم ضغط مفتاح الأمر و بعد إلصاق مسار الملف بمربع الحوار مع اسمه و الذي تحصل عليه من Properties>security حيث يتضمن اسم الملف مع المسار و عند فتح ملف الإكسل ستجد البيانات قد ظهرت و كل في تبويب باسم الجدول أعتذر مرة أخرى فلم أتمكن من التعديل على قاعدة البيانات لديك. أرسلت التعليق عن طريق الجوال

بارك الله بك و جزاك خيراً

السلام عليكم لكل إيجابيات و سلبيات لكن العقبة الكبرى هي أن الأسئلة تطرح بحثاً عن حل لمشكلة أو استفساراً عن طريقة . و في الغالب فإن المسألة ستكون مركبة أو ان طارح السؤال - هذا في أحسن الأحوال- لا يعرف بالضبط أين يجب أن يضع السؤال لعدم علمه بمناط استفساره. فكيف سيكون التقسيم و ما هي الإيجابيات من ذلك بمقابل السلبيات؟

السلام عليكم الكود يعملو لم يظهر الخطأ ربما لم تقم بتهيئة الملف الذي ترغب بنقل الجداول إليه .

السلام عليكم Option Compare Database Option Explicit Private Sub Command2_Click() Dim strFile As String Dim varItem As Variant strFile = InputBox("Designate the path and file name to export to...", "Export") If (strFile = vbNullString) Then Exit Sub For Each varItem In Me.List0.ItemsSelected DoCmd.TransferSpreadsheet transferType:=acExport, _ spreadsheetType:=acSpreadsheetTypeExcel9, _ tableName:=Me.List0.ItemData(varItem), _ fileName:=strFile Next MsgBox "Process complete.", vbOKOnly, "Export" End Sub Private Sub Form_Open(Cancel As Integer) Dim strTables As String Dim tdf As TableDef For Each tdf In CurrentDb.TableDefs If (Left(tdf.Name, 4) <> "MSys") Then strTables = strTables & tdf.Name & "," End If Next strTables = Left(strTables, Len(strTables) - 1) Me.List0.RowSource = strTables End Sub مصدر الأوامر موقع utteracess

السلام عليكم لماذا لا تفكر بصورة معاكسة ؟ اربط الإكسل بالأكسس قم بالخطوات التالية : استورد الورقة من إكسل إلى قاعدة أكسس ستظهر بأكسس كجدول قم بعمل النموذج الخاص بالإدخال لهذا الجدول الآن اذهب إلى برنامج إكسل قم بعمل ملف جديد. من تبويب بيانات في ملف الإكسل ستجد تبويباً فرعياً إحضار بيانات خارجية ادخل هذا التبويب ستجد من أكسس اختره و اتبع خطوات المعالج بعدها أغلق ملف الإكسل سيكون الإدخال عبر الأكسس و عندما ترغب بفتح الأكسل أغلق قاعدة بيانات أكس أولاً و بعدها اعرض ملف الإكسل ثم حدد أي خلية و بالماوس الأيمن ستجد خيار تحديث و بعد الضغط عليه ستظهر البيانات المدخلة حديثاً. الخطوات لن تأخد منك أكثر من ٣ دقائق و تستطيع التحكم بفرز و تصفية و تنسيق الجدول في إكسل .

بارك الله بك و جزاك الله خيراًووفقه عاماً مباركاً و عبادة مقبولة

السلام عليكم في بعض الأحيان نحتاج إلى عرض صورة في عمود أو خلية تبعاً لقيمة خلية في عمود آخر أو خلية أخرى مثلاً تغيير صورة منتج بناء على اسمه أو كوده و تغيير صورة موظف مع تغير اسمه الأكواد المستخدمة 'كود إضافة قائمة منسدلة إلى العمود الذي سيتم تغيير الصور بناء على قيمته Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next If Target.Column = 1 Then With Range("a" & Target.Row).Validation .Delete 'w_r=OFFSET($E$1;0;0;COUNTIF($E$1:$E$1000;"<>")) .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=w_r" .IgnoreBlank = True .InCellDropdown = True .ShowInput = True .ShowError = True End With End If End Sub 'إدراج الصور في الخلايا Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Application.ScreenUpdating = False Dim PicM As Picture Dim pictloc As String 'Created by H-E Khalf Dim x As String If Target.Column = 1 And Range("a" & Target.Row) = "" Then x = Range("c" & Target.Row).Address & "c" ActiveSheet.Shapes(x).Delete End If If Target.Column = 1 And Range("a" & Target.Row) <> "" Then x = Range("c" & Target.Row).Address & "c" ActiveSheet.Shapes(x).Delete pictloc = Application.ActiveWorkbook.Path & "\" & Range("a" & Target.Row).Value '& ".jpg" Set PicM = ActiveSheet.Pictures.Insert(pictloc) PicM.Select PicM.ShapeRange.LockAspectRatio = msoFalse PicM.ShapeRange.Height = Range("c" & Target.Row).Height PicM.ShapeRange.Width = Range("c" & Target.Row).Height PicM.Top = Range("c" & Target.Row).Top PicM.Left = Range("c" & Target.Row).Left PicM.Placement = xlMoveAndSize PicM.Name = Range("c" & Target.Row).Address & "c" Range("a" & Target.Row).Select End If Application.ScreenUpdating = True End Sub 'تصفير البيانات Private Sub CommandButton1_Click() Call Del End Sub Sub Del() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim Sh As Excel.Shape For Each Sh In ActiveSheet.Shapes If Right(Sh.Name, 1) = "c" Then Sh.Delete End If Next Dim Cel As Range Dim C As Integer For Each Cel In Range("a1:a1000") With Cel.Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = True .InCellDropdown = True .ShowInput = True .ShowError = True End With Next Range("a:a").ClearContents Range("a:a").ClearHyperlinks Selection.ClearContents Selection.ClearHyperlinks Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub ' جلب أسماء الصور من المجلد الذي سيوضع به الملف و هي من لاحقة ' jpg Private Sub Workbook_Open() Call Get_Files_Names End Sub Sub Get_Files_Names() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim fldpath Dim fso As Object, fld As Object, fil As Object, j As Long On Error Resume Next fldpath = Application.ActiveWorkbook.Path If fldpath = False Then MsgBox "Folder Not Selected" Exit Sub End If Columns("D:D").Clear Set fso = CreateObject("Scripting.FileSystemObject") Set fld = fso.getfolder(fldpath) j = 1 For Each fil In fld.Files Range("D" & j).Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=fil.Path, _ TextToDisplay:=fil.Name ActiveSheet.Hyperlinks.Delete j = j + 1 Next Dim Cel As Range For Each Cel In Range("D1:D1000") If Right(Cel, 4) <> ".jpg" Then Cel.Delete Shift:=xlUp End If Next Dim Cel1 As Range For Each Cel1 In Range("D1:D1000") If Left(Cel1, 1) = "~" Then Cel1.Delete Shift:=xlUp End If Next Set fso = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub قمت بكتابة بعض هذه الأكواد بينما اقتصر عملي على تعديل بعضها فقط و جزى الله خيراً من قدم الأكواد الأصلية. احتجت إل هذه الفكرة فاحببت مشاركتها مع من يبحث عنها إدراج صورة متغيرة حسب قيمة خلية.xlsm

أسأل الله لك التوفيق و السداد

ألف مبارك بارك الله بك و قواك

السلام عليكم هده الرسالة تظهر مع وجود Addins سابقاً تم حذفه دون إزالته من قائمة الإضافات في برنامج الإكسل فالإكسل يطلب هذه الإضافة المسجلة لديه في الوقت التي لم تعد موجودة على قرص الحاسب.

مبارك الترقية ألف مبارك

السلام عليكم أخي الفاضل إن إصدار Word 2013 لا يقبل بعض الخطوط أو يبدي نتائج غير متوقعة و قد اضطررت في بعض الأحيان إلى اللجوء إلى خطوط شبيهة أو العودة إلى إصدار ٢٠١٠ إلم أتمكن من الترقية إلى٢٠١٦ مع تمنياتي بالتوفيق

السلام عليكم لعلك تريد شيئاً كهذا Private Sub Worksheet_selectionChange (ByVal Target As Range) On Error Resume Next If Activecell.WrapText = False then Dim X As Integer X = Application.WorksheetFunction.Find("PutYourCharOrYourCritetiaRange",Activecell,1) If X > 0 then Activecell = Mid (Activecell.value,1,X) & chr(10) & Mid (Activecell.value, X+1,Len(Activecell)) End If End If End Sub

شكراً لك عمل رائع و جهد كبير بالرغم من أن موضوعات الحماية تبدو بالنسبة لي معقدة و خارج نطاق اهتمامي كوني لا أبيع البرامج أو أصممها لعملاء بل مجرد هاوٍ يقوم بإعداد بعض الملفات البسيطة لخدمة الزملاء أو للاستخدام في بيئة عمل مغلقة كما هو المتعارف عليه في مجموعة أوفيس. لكن يلفت اهتمامي حجم الجهد المبذول في مجال الحماية و الذي برأيي المتواضع لو جنِّد لعمل برامج بلغات برمجة لكن أجدى و أقوى ، و مقدار التفكير العميق الذي أصبح الأكسس يتجاوز حدوده و يتفوق على ذاته به و الذي سيحمل معه نتائج عظيمة لو أعمل في غير الأوفيس . و أسأل و أتمنى أن أحصل على إجابة من مطلع و متابع ، لماذا لا تقوم مايكروسوفت بتهيئة برامجها و تزويدها بإمكانيات الحماية المماثلة بصورة افتراضية؟لماذا تصر على ترك الباب موارباً لهذه المبادرات ؟

العزيز @خالد سيسكو أشكر لك اهتمامك كود جميل جداً سأحتفظ به إن شاء الله و لكن لا يحقق المطلوب كل ما انتهيت إليه هو استخدام الهوتميل و الذي ينقصني فيها الكثير و جزى الله خيراً الأستاذ @ابو محمد 316 فقد أصاب الهدف تماماً

شكراً جزيلاً لك

السلام عليكم لقد وجدت الحل بعمل مربع نص مصدره حقل من الجدول و عمل ماكرو بهذه الطريقة Me.TXT = Plaintext(me.TXT0) و بتنفيذه نحصل على المطلوب الأخ العزيز @SEMO.Pa3x الحل الذي تفضلت به مشكوراً هو حل طويل يقوم على استبدال جميع أكواد التنسيقات . لا أدري إن كان هناك كود سحري يستطيع بالمشاركة مع Replace إنجاز المطلوب . شكراً لكل من شارك أو رغب بالمساعدة

السلام عليكم لدي نموذج بحقل بخاصية ريتش تيكست تمكنني من تغيير التنسيقات حيث تحفظ في جدول على صورة وسوم هوت ميل لأتمكن بعدها من طباعتها بتقرير يكون حقله ريتش تيكست أيضاً و السؤال هل يمكن حفظ مدخلات النموذج مرتين إحداهما مع تنسيقاتالهوتميل و الأخرى دون ذلك في حقل آخر ضمن السجل نفسه.؟ و شكراً

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