راههای مختلفی برای ساخت پوشه در اکسل وجود دارد و یا بهتر بگویم اگر لیست پرسنل را داشته باشید و یا لیست کالاها با چند روش می توانید برای آنها برای هر نام یک پوشه در مسیر دلخواه ایجاد نمائید .
فهرست محتوا
ساخت پوشه در اکسل
در این آموزش رایگان فرض می کنیم که داده های ما در ستون A نوشته شده و نام پرسنل است و نامها از A2 شروع شده و همین طور قرار است که به آنها اضافه شود . و برای آنها پوشه ایجاد شود .
سناریو چیست؟
- میخواهیم با کلیک روی یک دکمه برای هر نام وارد شده در ستون A مشخصا در آدرس A2 تا جایی که داده وجد دارد مثلا A10 که البته همواره باید آخرین سلول دارای داده ، پوشه ساخته شود .
- مسیر پوشه ها مسیر خود فایل اکسل خواهد بود
- نام پوشه ها از ستون A گرفته می شود.
- در ستون B و متناظر با نام پوشه ها هایپر لینک ایجاد می شود .
- اگر داخل چوشه هر فرد یا نام ، فایلی وجود داشت نام نمایشی هایپر لینک برابر با تعداد فایلهای موجود در آن پوشه باشد.
- اگر فایلی در پوشه وجود نداشت نام نمایشی هایپرلینک برابر با “ندارد” باشد.
مراحل انجام کار
کافیست فایل با پسوند bas را در ادامه همین مطلب دانلود نمائید. و مطابق ویدیو آموزشی ابتدای مطلب عمل نمائید.
تا ساخت پوشه در اکسل را تجربه نمائید . البته کدهای نوشته شده را در ادامه می توانید کپی کنید و دیگر فایل bas را دانلود نکنید .
'============================================================================================
'نوشته شده توسط نادر بحري از آفيس باز
''براي ايجاد پوشه از به نام نوشته در محدوده آ2 تا جايي که داده وجود داشته باشد در ستون آ
' در ستون بي هم هايپرلينک ايجاد مي شود که مسير پوشه لينک مي شود
' نکات مهم
'به نام شيت و آدرسها دقت داشته باشيد
'در صورتي که مسير فايل اکسل شما فارسي باشد و يا در محلي باشد که دسترسي خواندن و نوشتن نداشته باشيد خطا خواهد داد '
'در صورت تمايل مي توانيد از دوره جامع کد نويسي در اکسل که در سايت آفيس باز ارائه شده استفاده کنيد تا کدها را درک نمائيد
'Officebaz.ir
'===========================================================================================
Public Sub CreateFoldersAndHyperlinks()
Dim lastRow As Long
Dim folderPath As String
Dim nameRange As Range
Dim nameCell As Range
Dim hyperlinkRange As Range
lastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
folderPath = ThisWorkbook.Path & "\"
Set nameRange = Range("A2:A" & lastRow)
Set hyperlinkRange = Range("B2:B" & lastRow)
For Each nameCell In nameRange
If Not IsEmpty(nameCell.Value) Then
folderPath = folderPath & Replace(nameCell.Value, ChrW(1740), "ي")
If Len(Dir(folderPath, vbDirectory)) = 0 Then
MkDir folderPath
End If
Dim fileCount As Long
fileCount = GetFileCount(folderPath)
Dim displayName As String
If fileCount > 0 Then
displayName = " (" & fileCount & ")" & " سند "
Else
displayName = "ندارد"
End If
folderPath = ThisWorkbook.Path & "\"
hyperlinkRange.Hyperlinks.Add Anchor:=hyperlinkRange, _
Address:=folderPath & Replace(nameCell.Value, ChrW(1740), "ي"), _
TextToDisplay:=displayName
Set hyperlinkRange = hyperlinkRange.Offset(1)
End If
Next nameCell
End Sub
Function GetFileCount(folderPath As String) As Long
Dim folder As Object
Dim files As Object
Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath)
Set files = folder.files
GetFileCount = files.Count
End Function
کدهای بالا شامل یک SUB و یک FUNCTION هست که در دوره جامع VBA توضیح کامل داده ایم .
نکات مهم :
در فایل ساخت پوشه در اکسل شما باید ریفرنسهای لازم فعال باشد که معمولا فعال است.
اگر نیازی به تغییر کد داشتین در قسمت نظرات عنوان نمائید تا کد را آپدیت کنیم.
اگر نیازی به تغییر کد داشتین در قسمت نظرات عنوان نمائید تا کد را آپدیت کنیم.
