بسم الله الرحمن الرحيم
اهلا بكم متابعى موقع عالم الاوفيس
درس مميز جدا وحصرى
اكسل | كيفية استيراد البيانات من ملف اكسل مغلق ومحمى بباسورد
كود ماكرو برمجى واحترافى فى استيراد البيانات من اى ملف اكسيل مغلق حتى لو كان محمى بباسورد
فى الكود البرمجى هذا يتم فتح مربع حوارى لتحديد ملف الاكسيل الذى سنقوم باستيراد البيانات منة
بمجرد تحديد الملف يظهر مربع حوارى اخر لاختيار الشيت او ورقة العمل التى سيتم استيراد البيانات منها
وبعد تحديد ورقة العمل يتم اظهار مربع حوارى اخر لتحديد المدى او الرانج الذى سنقوم بنسخ البيانات منه وليكن مثلا من A1:D200
ثم بعد ذلك يظهر اخر مربع حوارى وهو لتحديد النطاق الذى سيتم لصق البيانات فية
Sub Alsqr_Yasser()
Dim filename As Variant
Dim p As Long
filename =
Application.GetOpenFilename("Workbooks,*.xlsx,Templates,*.xltx,"
& _
"Macro-Enabled Workbooks,*.xlsm,Macro-Enabled
Templates,*.xltm," & _
"Binary Workbooks,*.xlsb,Excel 97-2003 Workbooks,*.xls," &
_
"Excel 97-2003 Templates,*.xlt", , "اختر ملف الاستيراد")
p
= InStrRev(filename, "\")
filename =
Left(filename, p) & "[" & Mid(filename, p + 1) &
"]"
If filename = False Then
MsgBox "نأسف لم يتم اختيار الملف بشكل صحيح"
Else
Dim Rng As Range
Dim Rngg As Range
On Error GoTo 1
Set Rng = Application.InputBox(prompt:="النطاق المراد نسخه:", Default:="", Type:=8)
If Rng Is Nothing Then GoTo 1
a = Rng.Rows.Count
b = Rng.Columns.Count
Set Rngg = Application.InputBox(prompt:="النطاق الذى يتم النسخ فيه:", Default:="", Type:=8)
If Rngg Is Nothing Then GoTo 1
With ActiveSheet.Range(Rngg.Resize(a, b).Address)
.FormulaArray = "='" & filename &
"Alsqr" & "'!" & Rng.Address
.Value = .Value
Rngg.Resize(a, b).Replace What:="0", Replacement:="",
LookAt:=xlPart, SearchOrder:=xlByRows
ActiveWindow.DisplayZeros
= False
End With
End If
GoTo 2
1
MsgBox "نأسف لم يتم تنفيذ الخطوات بشكل صحيح"
2
End Sub