كود حذف عدد غير معلوممن الاسطر من شيت اكسل باستخدام الاكسس

[SABER_EDP]

السلام عليكم

طلب تحويل ملف  من صيغة cvs الى  ملف اكسيل بصيغة xls بعد حذف عدد غير معلوم من الاسطر حتى بداية السطر التالى

CUSTOMER_NUMBER

ولكم الشكر

[jjafferr]

تفضل 

 

هذا الموضوع تكملة للموضوع:

http://www.officena.net/ib/topic/65628-كود-لحذف-الاسطر-3-الاولى-من-شيت-اكسل-بالأكسس/

 

 

هذا الكود الجديد الذي يقوم بالعمل:

Private Sub cmd_Remove3_Click()

    If Len(Me.txt_Dont_Delete & "") = 0 Then
        MsgBox "ÑÌÇÁ ÇÏÎÇá ÇáßáãÉ ÇáÊí ãäåÇ äÈÏà ÇáÊÓÌíá" & vbCrLf & _
               "Please write the word to start writing from"
        Me.txt_Dont_Delete.SetFocus
        Exit Sub
    End If
    
    
    Dim TextLine, File_Name, File_ext, Folder_Name, nFile_Name
    
    File_Name = Dir(Me.txtPath)                             'the file name only
    File_ext = Mid(File_Name, InStrRev(File_Name, ".") + 1) 'the file extension
    Folder_Name = Replace(Me.txtPath, File_Name, "")        'the folder name
    
    'a temp csv file to transfer to it the correct lines
    nFile_Name = Folder_Name & Mid(File_Name, 1, Len(File_Name) - Len(File_ext) - 1) & "_2." & File_ext
    
    'open both Input and Output files
    Open Me.txtPath For Input As #1
    Open nFile_Name For Output As #2
    
    d = 0
    i = 0
    Do While Not EOF(1)    ' Loop until end of file.
        Line Input #1, TextLine    ' Read line into variable.
        i = i + 1
        
        'skip the 1st 3 lines, and write the rest
        If InStr(TextLine, Me.txt_Dont_Delete) > 0 Then
            d = -1
        End If
        
        If d = -1 Then
            Print #2, TextLine
        End If
        
    Loop
    
    Close #1
    Close #2
    
    
    'now we have a csv file correctly saved,
    'convert it to xls
    
    'make reference to Microsoft Excel xx.x object Library
    
    Dim wBook As workbook
    
    Set wBook = Workbooks.Open(nFile_Name, Format:=6, Delimiter:=",")
    wBook.SaveAs Replace(Me.txtPath, ".csv", ".xls"), FileFormat:=xlExcel8
    wBook.Close False
    
    'delete the temp cvs file
    Kill nFile_Name

    MsgBox "Done"
    
End Sub

 

جعفر

298.1.Remove_Lines_csv.mdb.zip

[SABER_EDP]

السلام عليكم

جزاك الله خيرا

انت مبدع ما شاء الله

تسلم ايدك

[jjafferr]

[SABER_EDP]

اخى جعفر 

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

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

[jjafferr]

اذا فهمت سؤالك صح:

عندك ملف اكسل ، وهذا الملف مرتبط ببرنامج الاكسس.

 

الآن الى تغيير ملف الاكسل:

عندما تحذف ملف اكسل قديم ، وتأتي بملف اكسل جديد بنفس الاسم ، بنفس اسم/رقم الورقة (شيت) ، وفي نفس المسار ،

فان اكسس عند بدء تشغيله ، يقوم بربط ملف الاكسل ، حسب المعلومات السابقة (يعني المعلومات:بنفس الاسم ، بنفس اسم/رقم الورقة (شيت) ، وفي نفس المسار).

 

 

جعفر

[SABER_EDP]

اخى العزيز جعفر

حتى الان كل شى تمام

نحن حولنا ملف csvالى شيت اكسل  صح

نريد ان نربط هذا الشيت برمجيا بقاعدة البيانات  بنفس الاسم

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

[jjafferr]

الرابط التالي قد يفيدك:

http://www.officena.net/ib/topic/65681-مشكلة-طلب-كلمة-السر-عند-الارتباط-بقاعدة-البيانات/?do=findComment&comment=427471

 

 

جعفر

[SABER_EDP]

في ‎12‎/‎20‎/‎2015 at 21:21, jjafferr said:

تفضل 

 

هذا الموضوع تكملة للموضوع:

http://www.officena.net/ib/topic/65628-كود-لحذف-الاسطر-3-الاولى-من-شيت-اكسل-بالأكسس/

 

 

هذا الكود الجديد الذي يقوم بالعمل:

Private Sub cmd_Remove3_Click()

    If Len(Me.txt_Dont_Delete & "") = 0 Then
        MsgBox "ÑÌÇÁ ÇÏÎÇá ÇáßáãÉ ÇáÊí ãäåÇ äÈÏà ÇáÊÓÌíá" & vbCrLf & _
               "Please write the word to start writing from"
        Me.txt_Dont_Delete.SetFocus
        Exit Sub
    End If
    
    
    Dim TextLine, File_Name, File_ext, Folder_Name, nFile_Name
    
    File_Name = Dir(Me.txtPath)                             'the file name only
    File_ext = Mid(File_Name, InStrRev(File_Name, ".") + 1) 'the file extension
    Folder_Name = Replace(Me.txtPath, File_Name, "")        'the folder name
    
    'a temp csv file to transfer to it the correct lines
    nFile_Name = Folder_Name & Mid(File_Name, 1, Len(File_Name) - Len(File_ext) - 1) & "_2." & File_ext
    
    'open both Input and Output files
    Open Me.txtPath For Input As #1
    Open nFile_Name For Output As #2
    
    d = 0
    i = 0
    Do While Not EOF(1)    ' Loop until end of file.
        Line Input #1, TextLine    ' Read line into variable.
        i = i + 1
        
        'skip the 1st 3 lines, and write the rest
        If InStr(TextLine, Me.txt_Dont_Delete) > 0 Then
            d = -1
        End If
        
        If d = -1 Then
            Print #2, TextLine
        End If
        
    Loop
    
    Close #1
    Close #2
    
    
    'now we have a csv file correctly saved,
    'convert it to xls
    
    'make reference to Microsoft Excel xx.x object Library
    
    Dim wBook As workbook
    
    Set wBook = Workbooks.Open(nFile_Name, Format:=6, Delimiter:=",")
    wBook.SaveAs Replace(Me.txtPath, ".csv", ".xls"), FileFormat:=xlExcel8
    wBook.Close False
    
    'delete the temp cvs file
    Kill nFile_Name

    MsgBox "Done"
    
End Sub

 

جعفر

298.1.Remove_Lines_csv.mdb.zip

السلام عليكم

هل  يمكن ايضا الاختيار بين من السطر الرابع  مثلا الى السطر2000

او بين كلمتين

كلمة  فى اول الشيت وكلمة  معينة فى الشيت ؟

جزاك الله خيرا جعفر

[jjafferr]

وعليكم السلام

 

يا رجال ، بعد سنه وثلاثة اشهر تقريبا تتذكر موضوع قديم

 

همممم ، هو كل شيء تقريبا ممكن ، خصوصا ان الكود اعلاه مرن ،

ولكن قبل ان ارد عليك بالايجاب ، اعطني التفاصيل لوسمحت ، بمثال تفصيلي ، ومرفق ، حتى نستطيع التجربة عليه

 

جعفر

 

[SABER_EDP]

11 ساعات مضت, jjafferr said:

وعليكم السلام

 

يا رجال ، بعد سنه وثلاثة اشهر تقريبا تتذكر موضوع قديم

 

همممم ، هو كل شيء تقريبا ممكن ، خصوصا ان الكود اعلاه مرن ،

ولكن قبل ان ارد عليك بالايجاب ، اعطني التفاصيل لوسمحت ، بمثال تفصيلي ، ومرفق ، حتى نستطيع التجربة عليه

 

جعفر

 

 

يا اخى جعفر عند الشدائد نتذكر الرجال

اريد حذف 3 اسطر الاولى

وحذف من السطر 534

وحتى النهاية

يعنى من السطر الرابع حتى بداية الكلمة textbox54

هو ما اريدة فى الملف

وتحويل الملف الى اكسل

سلام عليكم

 

 

SalesByCustomerType.zip

[SABER_EDP]

للرفع