اكواد اكسل منوعة

انشاء ملف Word بنفس القيم الموجودة فى ملف الاكسيل

Sub proWord()
Dim varDoc As Object

        Set varDoc = CreateObject("Word.Application")

                  varDoc.Visible = True
                  Sheets("ورقة1").Range("A1:B15").Copy
                  varDoc.documents.Add
                  varDoc.Selection.Paste
                  varDoc.activedocument.SaveAs ThisWorkbook.Path & "/" & "منتديات اوفيسنا.doc"
                  varDoc.documents.Close

        varDoc.Quit
        Application.CutCopyMode = False
End Sub

جمع اكثر من خلية فى خلية

Sub جمع()
Range("h9").Value = Application.WorksheetFunction.Sum(Range("e7:g9"))
End Sub

جمع عمود فى خلية

Sub جمع_عمود()
Range("d5").Value = Application.WorksheetFunction.Sum(Range("d1:d4"))
End Sub

تحديد مجموعة خلايا

Sub شكلبيضوي8_نقر()
Range("A1:G5").Select
End Sub

  
كود لاخفاء اشرطة الادوات مع اظهار اسمائها فى الخلية A

Sub HideAllToolbars()
Dim TB As CommandBar
    Dim TBNum As Integer
    Dim mySheet As Worksheet
    Set mySheet = Sheets("ورقة1")
    Application.ScreenUpdating = False

    mySheet.Cells.Clear
    
    TBNum = 0
    For Each TB In CommandBars
        If TB.Type = msoBarTypeNormal Then
            If TB.Visible Then
                TBNum = TBNum + 1
                TB.Visible = False
                mySheet.Cells(TBNum, 1) = TB.Name
            End If
        End If
    Next TB
    Application.ScreenUpdating = True
End Sub

كود لاظهار اشرطة الادوات

Sub RestoreToolbars()
    Dim mySheet As Worksheet
    Set mySheet = Sheets("ورقة1")
    Application.ScreenUpdating = False

    On Error Resume Next
    For Each cell In mySheet.Range("A:A").SpecialCells(xlCellTypeConstants)
        CommandBars(cell.Value).Visible = True
    Next cell
    Application.ScreenUpdating = True
End Sub

كود لعمل انقسام لورقة اكسيل

Sub SplitWindow()
Dim freezeMode As Boolean, win As Window
  If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
 
  Set win = ActiveWindow
  freezeMode = win.FreezePanes
  win.FreezePanes = False
 
  If win.Split Then win.Split = False: Exit Sub
  win.SplitRow = ActiveCell.Row - win.ScrollRow
  win.SplitColumn = ActiveCell.Column - win.ScrollColumn
  win.FreezePanes = freezeMode
End Sub

اخفاء واظهار خطوط الشبكة ورؤس الصفوف والاعمدة

Sub ToggleHeadingsGrids()
Dim gridMode&, headingsMode&
 
  On Error Resume Next
 
  headingsMode = ActiveWindow.DisplayHeadings
  gridMode = ActiveWindow.DisplayGridlines
 
  If headingsMode And Not gridMode Then
    headingsMode = False
  ElseIf Not headingsMode And Not gridMode Then
    gridMode = True
  ElseIf Not headingsMode And gridMode Then
    headingsMode = True
  Else
    gridMode = False
  End If
 
  ActiveWindow.DisplayHeadings = headingsMode
  ActiveWindow.DisplayGridlines = gridMode
End Sub

انشاء دالة للجمع باسمك

Function kandeel(a As Integer, b As Integer) As Integer
kandeel = a + b
End Function

انشاء دالة للقسمة

Function division(x, y)
    If y > 0 Then
        division = x / y
    Else
        division = "division impossible"
    End If
End Function

كود لطباعة مدى من الخلايا تقوم بتحديده

Sub طباعة()
Range("a4:f24").Select
Selection.PrintOut copies:=1, preview:=True, collate:=True
A = MsgBox("هل تود طباعة التحديد الذى عاينته؟", vbYesNo + vbQuestion, "طباعة")
If A = vbYes Then
With ActiveSheet
.PrintOut
End With
End If
End Sub