gamalin

البقاء لله لله ما اعطى ولله ما اخذ نسأل الله العظيم رب العرش العظيم ان يلهمهم الصبر والسلوان وان يأجرهم بمصابهم وان يخلف عليهم خيرا وان يرزقهم بالزرية الصالحة

الكود بعد اصلاح الخط العربي وخالص تحياتي لاخي عمر MyPrinter1 = "\\S_mokhtar\hp LaserJet 1320 PCL 6 on Ne04:" MyPrinter2 = "\\Mamdouh\hp LaserJet 1320 PCL 6 on Ne02:" ' Company_1 = "شركة مدستار مصر" Company_2 = "الصناعة" Company_3 = "اكتب أسم الشركة 3" 'Company_4 = "اكتب أسم الشركة 4" ' Defprinter = Application.ActivePrinter MyCompany = Sheets("Sheet2").Range("C30") Select Case MyCompany Case Company_1 ' Application.ActivePrinter = MyPrinter1 ' ***هذا السطر مثال*** Application.ActivePrinter = MyPrinter2 Case Company_2 Application.ActivePrinter = MyPrinter1 Case Company_3 Application.ActivePrinter = "حسب اسم الشركة بدون علامة التنصيص(MyPrinter1 او MyPrinter2)" ' Case Company_4 ' Application.ActivePrinter = "حسب اسم الشركة بدون علامة التنصيص(MyPrinter1 او MyPrinter2)" End Select

بسم الله الرحمن الرحيم وبه نستعين اتوجه بالشكر والعرفان لاخي تامر وذلك على تواصله معي وتعاونه في حلة مشكلة اختيار الطابعة واتوجه الى جميع مشرفي المنتدى ورواده والى اخي تامر بالاعتذار عن تأخري في وضع الكود وذلك لظروف خارجة عن ارادتي واسمحوا لي بوضع كود اخي تامر وعذرا فاللغة في الاوفيس لدى بها مشكلة لذا الحروف العربية لا تظهر بجودة وسأضع الكود مرة اخرى غدا او اذا سمح اخي تامر في وضعه بالشكل المحترف اللائق بهذا الكود واليكم الكود Dim Defprinter As String Dim Test ' MyPrinter1 = "ÇßÊÈ ÇÓã ÇáØÇÈÚÉ 1" MyPrinter2 = "ÇßÊÈ ÇÓã ÇáØÇÈÚÉ 2" ' Company_1 = "ÇßÊÈ ÃÓã ÇáÔÑßÉ 1" Company_2 = "ÇßÊÈ ÃÓã ÇáÔÑßÉ 2" Company_3 = "ÇßÊÈ ÃÓã ÇáÔÑßÉ 3" 'Company_4 = "ÇßÊÈ ÃÓã ÇáÔÑßÉ 4" ' Defprinter = Application.ActivePrinter MyCompany = Sheets("Sheet2").Range("C30") Select Case MyCompany Case Company_1 ' Application.ActivePrinter = MyPrinter1 ' ***åÐÇ ÇáÓØÑ ãËÇá*** Application.ActivePrinter = "ÍÓÈ ÇÓã ÇáÔÑßÉ ÈÏæä ÚáÇãÉ ÇáÊäÕíÕ(MyPrinter1 Çæ MyPrinter2)" Case Company_2 Application.ActivePrinter = "ÍÓÈ ÇÓã ÇáÔÑßÉ ÈÏæä ÚáÇãÉ ÇáÊäÕíÕ(MyPrinter1 Çæ MyPrinter2)" Case Company_3 Application.ActivePrinter = "ÍÓÈ ÇÓã ÇáÔÑßÉ ÈÏæä ÚáÇãÉ ÇáÊäÕíÕ(MyPrinter1 Çæ MyPrinter2)" ' Case Company_4 ' Application.ActivePrinter = "ÍÓÈ ÇÓã ÇáÔÑßÉ ÈÏæä ÚáÇãÉ ÇáÊäÕíÕ(MyPrinter1 Çæ MyPrinter2)" End Select

حمدا لله ابا حسين

اسماء الشركات يأتي دوما في f1 في sheet 1 ستجد شركة مدستار مصر مكتوبة واشكر لك اهتمامك

______________2.rarالاخ تامر جزاك الله كل خير في البداية اتوجه اليك بالتحية والشكر للاهتمام ثانيا لصعوبة الوصول للجهاز الموصوع عليه الطابعتان حاليا حاولت ان اجرب على جهازي وهو على شبكة داخلية وموصول بالعديد من الطابعات حاولت نسخ الاسم واستبداله بالتي بالكود لم يقبل واعتقد لان هذه الطابعات يوجد باسمها on ثم اسم الجهاز علما بان اسم الطابعات على الجهاز الاخر hp1320 فقط لم يعمل العكود وتوقف عن العمل فارجوا التكرم ودراسة هذه الحالة ايضا وهي كون الطابعات موصولة على اجهزة اخرى بالشبكة وهل يتم كتابة اسماء الطابعات ام مسارها مثلا ..... \Mamdouh\\ ملاحظة اسماء الطابعات كام تظهر لدي بقائمة الطابعات والفاكسات الموصولة لدي موجودة بالكود

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

مشاركة اختيار الطابعة

الاختامر والاخوة الافاضل برجاء الادلاء بدلوكم في هذا الامر للاهمية

الاخ هادي برجاء بحث هذا الامر

______________.rarالاخ تامر وهادي وعلي وباقي مشرفي القسم جزاكم الله خيرا لدي ملف به زر للطباعة والترحيل ولكنه يطبع فواتير اكثر من شركة وقمت بتوصيل اكثر من طابعة على الجهاز وتم تسمية كل طابعة باسم الشركة ( طابعات دوت ماتريكس والورق رول وثابت بكل طابعة ) لذا اود بتغيير اسم الشركة في الخلية t9 في الملف المرفق من مصر للصناعة او العكس تتغير الطابعات تبعا لذلك فاذا تم اختيار كلمة مصر من القائمة يتم الطباعة على الطابعة مصر والعكس صحيح فهل يمكن ذلك بكود يتم اضافته على كود الطباعة حيث انه الان يطبع على الطابعة الافتراضية فهل يمكن تغيير ذلك ليطبع في كل مرة على طابعة مختارة في كل مرة وتتغير تبعا للشرط السابق ذكره ارجو التكرم والاهتمام بالامر

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

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

omar1.rarالاخ تامر جزاك الله كل خير على موضوع import واسمحلي ان اضيف نفس الملف لنكمل عليه كيف يمكن حماية هذا الشيت المحتوي على الماكرو ومع هذا يعلم الماكرو بكفاءة حيث لدي ملف به العديد من الماكرو وعند محاولة حمايته من التعديلات يتوقف الماكرو عن العمل واخيرا لدي ملف ولكن حجمه كبير كثيرا عن المسموح به واريد ان ارفقه لك لاعرف رايك واذا كان هناك امكانيات للتطويره فهل من طريقة لوضعه بالمنتدى او ارساله لك

بسم الله ماشاء الله يعني والله مش عارف اقول لك ايه ربنا يبارك لك ويبارك فيك وينفعك وينفع بعلمك واشكرك لتواصلك واهتمامك يعمل وبفاءة عالية جدا

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

ارجوا ان تتواصل اخ تامر ونتوصل الى الحل

اخي تامر جزالك الله الف خير وسوف اجرب الكود وارد عليك اما بخصوص البانات المحدث حاولت كثيرا ادارج ملفات ولكن غالبا حجمها بيكون اكبر من ال50كيلوا الخصصة اما عن الكود الكامل هو Sub importdata() ' ' importdata Macro ' Macro recorded 14/10/2006 by mohd_g ' ' Sheets("sheet1").Select Cells.Select Selection.ClearContents Selection.QueryTable.Delete With ActiveSheet.QueryTables.Add(Connection:="TEXT;d:\ozontrnprint.csv", _ Destination:=Range("A1")) .Name = "ozontrnprint" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 1256 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileOtherDelimiter = """" .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End Sub وسوف بعون ارفق ملف بهذا الامر واشكرك كثيرا لتفاعلك والله لو توصلنا لها لحلت لي مشاكل عظيمة لاني عامل ارتباطات بين الاكسل والعديد من البرامج كلها تعتمد على هذا الارتباط

محاسب / محمد عاطف (gamalin) محاسب مصري دفعة 91 مدير حسابات بشركة مصرية اجيد التعامل كمستخدم للاكسل وخلفية عن بعض برامج الاوفيس الاخرى تفيد كثيرا واحب التعارف والتعاون واود ان اسجل امتناني لمشرفي المنتدى وكل من ساهم في وجود مثل هذا العمل الرائع جزاهم الله خيرا

الاستاذ تامر جزاك الله كل خير هل يمكن ان نطمع في شرح الكود الذي قمت باضافته في مشاركتك السابقة لنفهمه ونستطيع تغيير فيه باسم الملف او الفلدر او نوع الملف نرجوا ان تتمكن من ذلك لدي ملف اكسل يتم عمل import لبيانات من txt له واريد بنفي الفكرة دوما يبحث عن ملف النص في نفس الفولدر مرفق كود الجلب واجريت محاولة لتعديلة بالكود بتاعك وفشلت نرجوا التكرم بالتعديل قبل التعديل Sheets("sheet1").Select Cells.Select Selection.ClearContents Selection.QueryTable.Delete With ActiveSheet.QueryTables.Add(Connection:="TEXT;d:\ozontrnprint.csv", _ Destination:=Range("A1")) .Name = "ozontrnprint" بعد محاولة التعديل الفاشلة Sheets("sheet1").Select Cells.Select Selection.ClearContents Selection.QueryTable.Delete myfilename = "ozontrnprint" mypath = ActiveWorkbook.Path myfullname = mypath & "\" & myfilename & ".csv" Workbooks.Open Filename:=myfullname With ActiveSheet.QueryTables.Add(Connection:="TEXT;myfullname", _

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

الحل يكمن في وضع كلمة HIDDEN بعد اسم المجال في الاكواد فيجوال بيسك للملف وسوف ارفق الكود لاحقا

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

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

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