البحث في الموقع

أرجو ان ينال اعجابكم هذا الكود ‘The code for div Sub div1() Dim x As Double, i As Integer, r As Integer Dim c As Integer, m As Integer, j As Integer Dim lr As Integer 'lr = Cells(Rows.Count, 1).End(xlUp).Row + 1 'last row + 1 Range("a5:z100").ClearFormats Range("a5:z100").ClearContents r = 5 c = 2 x = Cells(3, 3).Value if x<0 then x=abs(x) end if If x Mod 2 = 0 Then m = x / 2 Else m = x / 2 + 0.5 End If For i = 1 To m If x Mod i = 0 Then Cells(r, c).Select With Selection.Font .Name = "Traditional Arabic" .Size = 20 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With Selection.Font.Bold = True Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone ( With Selection.Borders(xlEdgeLeft .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With ( With Selection.Borders(xlEdgeBottom .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With ( With Selection.Borders(xlEdgeRight .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With ( With Selection.Borders(xlInsideVertical .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With ( With Selection.Borders(xlInsideHorizontal .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Cells(r, c).Value = i c = c + 1 If c > 9 Then c = 2 r = r + 1 End If End If Next i ( Cells(r, c).Value =abs( x Cells(r, c).Select With Selection.Font .Name = "Traditional Arabic" .Size = 20 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With Selection.Font.Bold = True Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone ( With Selection.Borders(xlEdgeLeft .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With ( With Selection.Borders(xlEdgeTop .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With ( With Selection.Borders(xlEdgeBottom .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With ( With Selection.Borders(xlEdgeRight .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With ( With Selection.Borders(xlInsideVertical .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With ( With Selection.Borders(xlInsideHorizontal .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub (this is the end of (div)