الموضوع يهم كل مستعملي VBA

[omarjawalkey]

السلام عليكم ورحمة الله وبركاته إخواني رواد هذا المنتدى العظظظظظظيم بكل ما تحمله الكلمة من معنى

صممت واجهة بالفيجويل بيسك للتطبيقات ( إكسيل ) بدي أعرف أربعة أمور تحيرني وتحيل بين وبين التمتع بخدمات هذا البرنامج العملاق وهي كالثالي :

1- في إمكانية لجعل الواجهة المصصمة تطلع تلقائيا + إخفاء الورقات (sheet1,sheet2,sheet3) المتصلة بالواجهة

2- هل يوجد كود VBA يوضع في زر يكمن دورو في حفظ sheet1,sheet2 باسم خليتين وفي داخل مجلد تم تحديده مسبقا .

3- هل يوجد كود VBA يوضع في زر يكمن دورو في طبع الأوراق + كود تحديد الأوراق المراد طباعتها + عدد النسخ .

وأتأسف على كثرت الأسئلة وإنشاء الله أجد عندكم الأجوبة لي تريح قلبي...

تحياتي...

[محمد حجازي]

1- في إمكانية لجعل الواجهة المصصمة تطلع تلقائيا + إخفاء الورقات (sheet1,sheet2,sheet3) المتصلة بالواجهة

راجع الرابط التالي :

http://www.officena.net/ib/index.php?showtopic=7876

2- هل يوجد كود VBA يوضع في زر يكمن دورو في حفظ sheet1,sheet2 باسم خليتين وفي داخل مجلد تم تحديده مسبقا .

جرب الكود :

Public NewWorkbok As Object
Sub SaveSheet()
On Error GoTo NoSave
Dim MyPath As String
Dim NumberSheets() As Integer
MyPath = Application.GetSaveAsFilename(InitialFileName:="officena", FileFilter:="Excel Files (*.xls), *.xls", Title:="أدخل اسم الملف الذي تريد حفظه")
If MyPath = "False" Then Exit Sub
Set NewWorkbok = Workbooks.Add
Workbooks("16834").ActiveSheet.Copy Before:=Workbooks(NewWorkbok.Name).Sheets(1)
ReDim NumberSheets(2 To NewWorkbok.Worksheets.Count)
For i = 2 To NewWorkbok.Worksheets.Count
  NumberSheets(i) = i
Next i
Application.DisplayAlerts = False
With NewWorkbok
 .Sheets(NumberSheets).Delete
 Application.DisplayAlerts = True
 .SaveAs Filename:=MyPath
 .Close
End With
Exit Sub

NoSave:
If Err = 1004 Then
  Application.DisplayAlerts = False
  NewWorkbok.Close
  Application.DisplayAlerts = True
Else
  MsgBox Err.Description
End If
End Sub

الموجود في الرابط ارابط التالي :

http://www.officena.net/ib/index.php?showtopic=7581

3- هل يوجد كود VBA يوضع في زر يكمن دورو في طبع الأوراق + كود تحديد الأوراق المراد طباعتها + عدد النسخ .

لا أعتقد أنك بحاجة لهذا الكود ، وذلك لأن الرسائل التي سيظهرها الكود لن تختلف أبدأ عن معالج الطباعة الخاص بالاكسل .

[omarjawalkey]

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

[omarjawalkey]

في السؤال الثاني

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

[محمد حجازي]

السلام عليكم ....

جرب التعديل التالي :

Public NewWorkbok As Object
Sub SaveSheet()
  On Error GoTo NoSave
  Dim NumberSheets() As Integer
  Set NewWorkbok = Workbooks.Add
  Workbooks("Book1").ActiveSheet.Copy Before:=Workbooks(NewWorkbok.Name).Sheets(1)
  ReDim NumberSheets(2 To NewWorkbok.Worksheets.Count)
  For i = 2 To NewWorkbok.Worksheets.Count
    NumberSheets(i) = i
  Next i
  Application.DisplayAlerts = False
  With NewWorkbok
    .Sheets(NumberSheets).Delete
  Application.DisplayAlerts = True
    .SaveAs Filename:=Workbooks("Book1").Path & "\" & Workbooks("Book1").ActiveSheet.Range("A1").Value
    .Close
  End With
Exit Sub

NoSave:
  If Err = 1004 Then
    Application.DisplayAlerts = False
    NewWorkbok.Close
    Application.DisplayAlerts = True
  Else
    MsgBox Err.Description
  End If
End Sub

و لكن انتبه إلى أن المصنف هو باسم Book1 و أن اسم المصنف الجديد موجود في الخلية A1 من الورقة النشطة (التي تريد حفظها).

[omarjawalkey]

أخي بارك الله فيك وزاد في علمك

تم تعديل مايو 15, 2005 بواسطه omarjawalkey