কিভাবে এক্সেল ইউজারফর্ম দিয়ে “কলাম” কপি করবেন – How to copy “Column” with Excel UserForm

এই টিউটোরিয়ালে, আমরা একটি টেমপ্লেট তৈরি করেছি যেখানে আমরা ইউজারফর্ম ব্যবহার করে একটি শীট থেকে অন্য শীটে কলাম কপি করতে পারি। আমাদের ডাটাবেস এবং রিপোর্ট শীট সমন্বিত একটি ওয়ার্কবুক আছে।

 আমরা ইউজারফর্মে 2টি তালিকা বাক্স রেখেছি। ডেটাবেস শীটের কলাম শিরোনাম যেগুলিতে ডেটা রয়েছে তা UserForm_Initialize পদ্ধতিতে নিম্নলিখিত VBA কোডগুলির সাথে Listbox1 এ তালিকাভুক্ত করা হয়েছে : 

Dim sutn, lst_column As Integer
lst_column = Sheets("Database").Cells(1, Columns.Count).End(xlToLeft).Column
For sutn = 1 To lst_column
ListBox1.AddItem Sheets("Database").Cells(1, sutn).Value
If Sheets("Database").Columns(sutn).Hidden = True Then
ListBox1.Selected(sutn - 1) = True
End If
Next

lst_column = Sheets("Database").Cells(1,Columns.Count).End(xlToLeft).Column 

 ডাটাবেস শীটে, আমরা এই কোডগুলির সাথে সর্বশেষ ব্যবহৃত কলাম নম্বর শিখি এবং এটিকে lst_column ভেরিয়েবলে বরাদ্দ করি। ডাটাবেস শীটে, এই সংখ্যাটি 12 এবং এটি কলাম L নির্দেশ করে।

 আমাদের কলামগুলি (column headers) স্থানান্তর করতে হবে যা আমরা কপি করতে চেয়েছিলাম, ListBox1 থেকে ListBox2 এ। ব্যবহারকারীর ফর্মে, আমরা তালিকা বাক্সগুলির মধ্যে আইটেমগুলি সরানোর জন্য বোতামগুলি ব্যবহার করেছি।

লিস্টবক্স 1 থেকে লিস্টবক্স 2 এ একটি আইটেম সরানোর জন্য বাটনের কোডগুলি (কমান্ডবাটন 5) নিম্নরূপ : 

Private Sub CommandButton5_Click()
Dim deger As String, m As Integer
If ListBox1.ListIndex = -1 Then 'If there is no item selected on listbox,no move will be made.
MsgBox "Choose an listbox item from left", , ""
Exit Sub
End If

deger = ListBox1.Value
For m = 0 To ListBox2.ListCount - 1
If deger = CStr(ListBox2.List(m)) Then
MsgBox "This item already exists in ListBox2", vbCritical, ""
Exit Sub
End If
Next
ListBox2.ListIndex = -1
ListBox2.AddItem ListBox1.Value
ListBox1.RemoveItem (ListBox1.ListIndex)
Call animation_to_right
End Sub

deger = ListBox1.Value
For m = 0 To ListBox2.ListCount - 1
If deger = CStr(ListBox2.List(m)) Then
MsgBox "This item already exists in ListBox2", vbCritical, ""
Exit Sub
End If
Next
 

 এই লুপের সাহায্যে, আমরা যে ListBox1 আইটেমটি সরাতে চাই তা ListBox2 এ আছে কিনা তা পরীক্ষা করা হয়। ListBox2 এ এই আইটেমটি ইতিমধ্যেই থাকলে, আইটেমটি সরানো হয় না। ListBox2 থেকে ListBox1 এ একটি আইটেম সরানোর সময়, এটি একইভাবে VBA লুপের মাধ্যমে নিয়ন্ত্রিত হয়।

 এছাড়াও, আইটেমগুলি Listbox2 থেকে Listbox1 এ সরানো যেতে পারে। Listbox2-এ নির্বাচিত আইটেমটি স্পিন বাটন টিপে উপরে বা নিচে সরানো যেতে পারে। 

আইটেমগুলিকে উপরে এবং নীচে সরাতে আমরা স্পিন বাটনে নিম্নলিখিত কোডগুলি যুক্ত করেছি : 

Private Sub SpinButton1_SpinDown()
With ListBox2
If .ListIndex = -1 Then Exit Sub
If .ListIndex < .ListCount - 1 Then
.AddItem .List(.ListIndex), .ListIndex + 2
.RemoveItem .ListIndex
.ListIndex = .ListIndex + 1
End If
End With
End Sub

Private Sub SpinButton1_SpinUp()
With ListBox2
If .ListIndex = -1 Then Exit Sub
If .ListIndex > 0 Then
.AddItem .List(.ListIndex), .ListIndex - 1
If .ListCount - 1 = .ListIndex Then
.RemoveItem .ListIndex
.ListIndex = .ListIndex - 1
Else
.RemoveItem .ListIndex
.ListIndex = .ListIndex - 2
End If
End If
End With
End Sub

 আমরা ইউজারফর্মের 3টি বাটনের জন্য MouseMove ইভেন্টকে ট্রিগার করে এমন কোডগুলি যোগ করেছি। চিত্রটি CSS হোভার প্রভাবের অনুরূপ।

উপরের বাটনের জন্য MouseMove পদ্ধতি (CommandButton5) :
Private Sub CommandButton5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton5.Width = 38
CommandButton5.Left = 150
End Sub

আমরা ইউজারফর্মের জন্য MouseMove পদ্ধতি যুক্ত করেছি যাতে মাউস বাটনটি ছেড়ে দিলে বাটনটি  তার ডিফল্ট অবস্থান এবং প্রস্থে ফিরে আসে।:
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton5.Width = 29
CommandButton5.Left = 150

 ডাটাবেস শীটের কলাম শিরোনাম ListBox2-এ সাজানোর পর, ListBox2-এ তালিকাভুক্ত কলামগুলি ফিল্টার বাটনে ক্লিক করে রিপোর্ট শীটে কপি করা হয়। কপি করার আগে রিপোর্ট শীট সেল সাফ করা হয়। 

VBA Codes of Filter button : 

For basliklar = 0 To ListBox2.ListCount - 1
baslangic_satiri = 2
Sheets("Report").Cells(baslangic_satiri - 1, basliklar + 1) = ListBox2.List(basliklar, 0)

Sheets("Database").Range(FirstCell, LastCell).AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Sheets("Database").Range(FirstCell, LastCell), _
CopyToRange:=Sheets("Report").Cells(baslangic_satiri - 1, basliklar + 1), _
Unique:=False
Next
Sheets("Report").Columns.EntireColumn.AutoFit 'Widths of columns are set.

lst_column = Sheets("Report").Cells(1, Columns.Count).End(xlToLeft).Column
For s = 1 To lst_column 'Background color of column headers
Sheets("Report").Cells(1, s).Interior.Color = RGB(218, 238, 243)
Sheets("Report").Cells(1, s).Font.Bold = True
Next

 রিপোর্ট শীটে কলাম কপি করার আগে অ্যানিমেটেড প্রগ্রেস বার দেখানো হয়। অন্যান্য ইউজারফর্মে প্রগ্রেস বার চালানো হয়. 

📥 Download sample workbook

By admin

Leave a Reply

Your email address will not be published. Required fields are marked *

error: Content is protected !!
%d bloggers like this: