مشکلات متره و ماکرویی که به داد من رسید

برای تهیه اسناد مناقصه برای یک خط لوله نفت به یک مشکل عظیم برخوردم . اول اینکه باید از فهرست بهای خط لوله نفت برای اسناد استفاده کنیم و دوما بعد اینکه قرارداد امضا شد یک قلم می شه یعنی قیمت کار بسته شد و بعد اگر احجام در حین کار تغییر کرد کارفرما نمی تونه براساس احجام واقعی قیمت رو در بیاره (آش شعله قلم کاری که کارفرما پخته برای خودش) . اما پیمانکار اگر احجام واقعی کار از احجام اسناد بالا بره مطمئنا مدعی می شه (کلیم می کنه) .

در فهرست بهای خط لوله نفت ریسه و جوشکاری در شیب های مختلف اضافه بهای مختلفی داره که برای بخش مهندسی در آوردن این طول ها کار راحتی نیست .من یک پرفیل طولی از خط پروژه مسیر داشتم که فایل اتوکد بود . اول شروع کردم به اندازه گیری از روی خط که دیدیم این کار شدنی نیست و تازه در طراحی اشتباهاتی رخ داده . دادیم مهندسی نقشه رو اصلاح کرد . حالا چطوری باید این فواصل رو با توجه به شیب از هم تفکیک کرد کار راحتی نبود و طول مسیر حدود 240 کیلومتر هم می شد. به فکر افتادم یک برنامه با VBA بنویسم که بتونه مشخصات خط ها رو به فایل اکسل ببره .که برنامه اطلاعات X, Y ‌شروع و انتهای تمامی خط ها رو در یک فایل تکست می ریزه بعد اونو با اکسل باز کردم و هر بلایی که دوست داشتم سر اعداد آوردم . مثلا طول خط ها ‌شیب رو حساب کردم بعد هم بر اساس شیب سورت کردم و طول مسیر در شیب های محدوده مورد نظر رو محاسبه کردم

برنامه را در  ادامه مطلب میذارم شاید بدردتون خورد Sub ALI()
Dim LineObj As AcadLine
Dim INEObj As AcadLine
Dim ssetObj As AcadSelectionSet
Dim sFileText As String
Dim iFileNo As Integer
Dim I, Count As Integer
iFileNo = FreeFile
‘open the file for writing
Open “D:\Test.txt” For Output As #iFileNo

Set ssetObj = ThisDrawing.SelectionSets.Add(”TEMP”)

‘ Add objects to a selection set by prompting user to select on the screen

ssetObj.SelectOnScreen
Count = ssetObj.Count
For I = 0 To Count – 1

Set LineObj = ssetObj.Item(I)

Print #iFileNo, I & “;” & LineObj.StartPoint(0) & “;” & LineObj.StartPoint(1) & “;” & LineObj.EndPoint(0) & “;” & LineObj.EndPoint(1)

Next
Close #iFileNo

ThisDrawing.SelectionSets(”TEMP”).Delete

End Sub

ضمنا فایل test.txt رو حتما باید اول کار در درایو D  درست کرده و خالی باشد

فیل تر در ماکرو

به درخواست یکی از بینندگان ( ضمنا دلیل جدانویسی عنوان را حتما خودتان می دانید!!!)

با استفاده از کد زیر می توانید در یک سری سلول فیل تر را فعال کنید

Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:=”a”

این دستورات ستون دوم یک رنج را بر اساس وجود کاراکتر a  فیل تر می کند

ضمنا بهترین روش برای یادگیری ماکرو ضبط کارهای عادی در اکسل تحت عنوان ماکرو می باشد و بررسی ماکرو نوشته شده توسط خود برنامه اکسل می باشد

البته یک کمی هم باید ویژوال بیسیک بلد باشید و راهنمای اکسل بهتر از هر کتابی می تواند به شما کمک کند

تبدیل عدد و تاریخ به حروف در ورد Word

سال گذشته یکی از خوانندگان درخواست کرد که من برنامه ای بنویسم که بشود در ورد عدد را به حروف تبدیل کرد و تاریخ را نیز به حروف تبدیل کرد.
بعد از مدتی که این فایل آماده شد از این خواننده خبری نشد.
حال این فایل را جهت دانلود قرار می دهم
امکانات این فایل می تواند جهت نوشتن چکها مانند نرم افزارهای چک نویس عمل کند
باکسها را می توان در هر جایی قرارداد و با توجه به صفحه مقصد طراحی کرد
برنامه اپن سورس بوده و برنامه آن قابل دیدن است. اگر کسی درخواست تغییر در آن دارد به راحتی خودش می توان این تغییرات را اعمال نماید.
فایل جهت دانلود

چیدمان جدید صفحه کلید فارسی برای آنهایی که فینگلیش تایپ می کنند

صفحه کلید جدیدی تعریف و طراحی کرده ام که می تواند وب را از دست فینگلیش خلاص کند . شما فینگلیش تایپ کنید اما حروف فارسی نوشته خواهد شد.
این یک برنامه اضافی نیست تنها یک چیدمان جدید برای صفحه کلید است که توسط برنامه Microsoft Keyboard Layout Creator درست شده است.
بعد از دانلود و باز کردن فایل زیپ یک فایل setup.exe وجود دارد که با اجرای آن یک زبان دیگر به کیبرد های شما اضافه خواهد شد برای اینکه تداخلی با فارسی استاندارد نداشته باشد زبان ازبک را انتخاب کرده ام با انتخاب آن آنهایی که فارسی نمی توانند تایپ کنند معادل فارسی کلید های تایپ شده درج خواهد شد مثلا به جای P پ و F ف و L ل ، M م ، N ن و الی آخر
شکل چیدمان حروف به شکل زیر است


نیم فاصله حرف “~” می باشد که برای فاصله چسبیده است مانند “می‌روم” که “می” جدا از “روم” نیست و همه یک کلمه شناخته می‌شود
چسبیدن مجازی “\” می باشد ( چسبیدن مجازی مثلا برای نوشتن ه‍ کاربرد دارد یعنی ه می نویسیم وبعد آن \ می زنیم

برنامه را از اینجا دانلود کنید

حجم فایل 250 کیلوبایت است

منتظر نظرات دوستان برای توسعه این صفحه کلید هستم

این صفحه کلید بر روی    XP تست شده اما چون به ویستا دسترسی ندارم  دوستان کارکرد آنرا بر روی ویندوز ویستا اطلاع دهند

ادیتور فارسی اتوکد ویرایش 4.00

نسخه نهایی ادیتور فارسی اتوکد آماده شده که امکان نوشتن با فونتهای IPT به آن اضافه شده است

همچنین امکان قفل شدن استایل و سایز جدید برای همه انتخابها اضافه شده است
دو فایل ضمیمه را در داخل مسیر اصلی برنامه اتوکد کپی کنید برای اجرا تنها دستور fe را در command تایپ کنید برنامه اتوماتیک لود شده و آماده اجراست

برای دانلود اینجا را کلیک کنید

محاسبه عملیاتی که به صورت تکست است

امروز مسئله ای برایم پیش آمده بود که ما اگر در یک سلول یک نوشته ای داشته باشیم مانند 120/5 چطوری آنرا محاسبه کنیم و به عدد 24 برسیم بعد از جستجوی و مطالعه فراوان  تابع زیر مسئله را حل کرد:

Private Function t2v(Refre)
t2v = Application.Evaluate(“=” & Refre)
End Function

ليست نام شيت ها در يك شيت جديد

با ماكرو زير مي توانيد تمامي اسامي شيت ها را در يك شيت جديد داشته باشيد
Private Sub sheetenames()

Set NewSheet = Sheets.Add(Type:=xlWorksheet)
For I = 1 To Sheets.Count
NewSheet.Cells(I, 1).Value = Sheets(I).Name
Next I

End Sub

ليست فايل هاي يك دايركتوري در اكسل

احتمالا خيلي لازم شده كه بخواهيد ليست فايلهاي يك دايركتوري را در يك شيت اكسل وارد كنيد

عجب كار سخت و طاقت فرسايي اگر تعداد فايلها زياد باشد

يك ماكرو كه مي تواند اين ليست را تهيه كند. ابتدا مسير مورد نظر را در سلول A1 وارد كنيد سپس ماكرو را اجرا كنيد تمامي فايلهاي يك دايركتوري پشت سر هم در سلولها نقش مي بندد

Private Sub dirfilename()
ali = Dir(ActiveSheet.Cells(1, 1).Text & “\*.*”)
I = 2
Do
ActiveSheet.Cells(I, 1) = ali
ali = Dir
I = I + 1
Loop
Until ali = “”
End Sub

سئوال و جوابي در باره برنامه تبدل تاريخ شمسي

با سلام

برنامه واقعاً سودمند شما را در خصوص تبديل تاريخ و تبديل عدد به حروف را دريافت نمودم . بسيار عالي و قابل استفاده بود . ضمن تشكر از زحمتي كه براي اين برنامه بسيار مفيد انجام داده ايد پيشنهاد مي كنم براي تفريق در تاريخ از هم (مثلاً محاسبه سن يا سنوات خدمت يك فرد تا تاريخي مشخص ) و جمع كردن يك تاريخ با عددي مشخص ( مثلاً 132 روز ديگر چه تاريخي مي شود )  نيز در صورت داشتن توابعي آنرا ارسال فرمائيد. و در غير اين صورت تقاضا دارم زحمت آنرا نيز بكشيد.

با تشكر مجدد : محمدرضا كيامرزي

===================================================

جناب آقاي كيامرزي

تمامي امكاناتي كه شما انتظار انجامش را داريد به راحتي قابل انجام است هرچند مي شود براي آنها ماكرو نوشت .

اما من مخالف نوشتن اين ماكرو هستم چون در برنامه اكسل كارهاي زيادي را با تركيب فرمولها مي شود. اگرچه نوشتن اين توابع زماني از من نمي گيرد 

 با افزايش مهارت اكسل خودتان از استفاده از اين برنامه لذت ببريد و با تركيب فرمولها چه كارهاي بزرگي را كه به راحتي مي تواند انجام دهيد . مثلا با تركيب توابع match و  index چه كارهاي بزرگي كه نمي شود كرد. 

- هر تاريخ شمسي را بخواهيد 132روز اضافه كنيد به راحتي ابتدا تاريخ شمسي را به ميلادي تبديل كنيد سپس بعلاوه 132 بكنيد حالا معادل تاريخ ميلادي آن به دست مي آيد حالا دوباره آنرا به شمسي تبديل كنيد. همه اين مراحل را مي شود در يك فرمول تعريف كرد.

=m2s(s2m(a1)+132)

- دو تاريخ را بخواهيد از هم كم كنيد هر دو را به ميلادي تبديل كنيد سپس آنها را از هم كم كنيد.

مثال :

a1: 1387/1/1

a2: 1387/6/27

حالا با نوشتن فرمول زير در هر سلولي مي شود تعداد روزهاي بين  اين دو تاريخ را دانست

=(s2m(a2) – s2m(a1))

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

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

به دليل درخواست يكي از خوانندگان سايت امكانات جديد به ماكرو تبديل تاريخ شمسي اضافه شد كه تغييرات اعمال شده در دو پست قبلي ويرايش گرديد

حالا تاريخ را به صورت حروفي هم مي تواند ببينيد