اذهب الي المحتوي
أوفيسنا

تعديل على كود نقل بيانات من ملفا الى اخر


الردود الموصى بها

اريد التعديل على الكود المرفق

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

الامتداد الموجود      xlsb

نريد ان نضيف باقى امتدادت الاكسيل على هذا السطر لتكون

xls      /      xlsx    /    xlsm        /    xlsb

الكود المراد التعديل عليه


Option Explicit
Dim Mybook As Workbook
Dim Mypath As String
Dim MyPasteSpecial
Dim MyCell As Range
Private Sub CommandButton2_Click()
Mybook.Activate
Unload kh_focopy
End Sub
Private Sub KHOpenFilename_Click()
On Error Resume Next
Mypath = Application.GetOpenFilename("ملف اكسل (*.xlsb), ", , "   اختار الملف   ")
If Mypath = True Then
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Workbooks.Open Mypath
    Application.DisplayAlerts = True
    kh_focopy.Height = 300
    RefEdit1.SetFocus
    Application.ScreenUpdating = True
End If
KH_TEXT.Caption = Mypath
On Error GoTo 0
1 End Sub
Private Sub KHCOPYMYRANGE_Click()
  On Error Resume Next
  If RefEdit1.Text = "" Then GoTo 1
  On Error GoTo 1
  kh_focopy.Hide
  Application.ScreenUpdating = False
    With Range([RefEdit1])
        .Copy
        MyCell.PasteSpecial MyPasteSpecial
        Application.CutCopyMode = False
    MsgBox "تم استيراد عدد " & Chr(32) & .Rows.Count & Chr(32) & " من السجلات بنجاح", 524288 + vbMsgBoxRtlReading, "الحمدلله"
    End With
    Application.ScreenUpdating = True
    Mybook.Activate
    Unload kh_focopy
    GoTo 2
1:
MsgBox "استخدام خاطىء", 524288, "تنبيه"
On Error GoTo 0
2 End Sub

Private Sub OptionPaste_1_Change()
If OptionPaste_1.Value = True Then MyPasteSpecial = xlPasteAll Else MyPasteSpecial = xlPasteValues
End Sub

Private Sub UserForm_Activate()
kh_focopy.Height = 150
OptionPaste_1.Value = True
End Sub

Private Sub UserForm_Initialize()
Set Mybook = ActiveWorkbook
Set MyCell = ActiveCell
End Sub

السطر المراد التعديل عليه

 

Mypath = Application.GetOpenFilename("ملف اكسل (*.xlsb), ", , "   اختار الملف   ")

 

رابط هذا التعليق
شارك

السلام عليكم

جربي اختي هذا التعديل

Mypath = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls;*.xlsx;*.xlsm;*.xlsb),*.xls;*.xlsx;*.xlsm;*.xlsb", Title:="إختر ملف")

 

25 دقائق مضت, سماح الهياتمى said:

اين ردود الاساتذة الاجلاء

 

  • Like 1
رابط هذا التعليق
شارك

  • 2 weeks later...

اساتذتى الاجلاء

الكود السابق يعمل على استدعاء بيانات من عمود واحد فقط ارجو ان يشمل الاستدعاء اكثر من عمود متفرق ينى مثلا جلب بيانات من عمود a      c    d   g    i   m

شكرا لكم جميعا

رابط هذا التعليق
شارك

في ١٢‏/٤‏/٢٠١٧ at 20:18, سماح الهياتمى said:

 

اساتذتى الاجلاء

الكود السابق يعمل على استدعاء بيانات من عمود واحد فقط ارجو ان يشمل الاستدعاء اكثر من عمود متفرق ينى مثلا جلب بيانات من عمود a      c    d   g    i   m

شكرا لكم جميعا

في ١٣‏/٤‏/٢٠١٧ at 16:07, سماح الهياتمى said:

اساتذتى الاجلاء

الكود السابق يعمل على استدعاء بيانات من عمود واحد فقط ارجو ان يشمل الاستدعاء اكثر من عمود متفرق ينى مثلا جلب بيانات من عمود a      c    d   g    i   m

شكرا لكم جميعا

 

رابط هذا التعليق
شارك

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

رابط هذا التعليق
شارك

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

اما المطلب الثانى

لكود السابق يعمل على استدعاء بيانات من عمود واحد فقط ارجو ان يشمل الاستدعاء اكثر من عمود متفرق ينى مثلا جلب بيانات من عمود a      c    d   g    i   m

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

استخدام خاطئ

 

رابط هذا التعليق
شارك

اساتذتى الاعزاء 

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

اما عند استخدام عمود واحد او اعمدة متجاورة يعمل الكود بشكل صحيح

الصورة الاولى عند تحديد عمودين غير متجاورين

 

p_470h09y11.png

والصورة الثانية تظهر رسالة الاستخدام الخاطئ

 

p_470dm8mc1.png

رابط هذا التعليق
شارك

انا عملت ايضا مع المغفتاح كنترول وظهرت رسالة الخطا بالرغم ةمن تسغيل الكود على اكثر من جهاز وكذا اوفيس 2007 واوفيس 2010

برجاء متابعة موضوعى من قبل الاساتذة 

ابو حنين

شوقى ربيع 

 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information