samedi 22 décembre 2018

برنامج جلب مواقيت الصلاة

البرنامج عبارة ملف إكسل يمكننا من جلب مواقيت الصلاة لبعض المدن الجزارية و كدا كل من مكة المكرمة، جدة و المدينة المنورة
مع عرض كل المعلومات الخاصة بالمدينة مثل عدد البلديات، الدوائر، المساحة و عدد السكان

المصدر مفتوح و يمكن للجميع العمل على البرنامج، نرجو  من الإخوى دعاء فقط


Sub XlsMilev()
'
' Macro1 Macro
' Macro enregistrée le 10/01/2017 par CAAR
'

'
' DESACTIVER SECEEN
Application.ScreenUpdating = False
On Error Resume Next
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

' DEMasquer le Feuil 2 et 3
Sheets("Tmp").Visible = True
Sheets("Parametre").Visible = True
Sheets("M-salat").Select
Range("P9").Select


Dim nabil1 As String
Dim nabil2 As String

Sheets("M-Salat").Select
nabil1 = Range("P12")
nabil2 = Range("P12")


    Sheets("Tmp").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
  
With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & nabil1, Destination:=Range("A1"))
       
        .Name = "show_prayertimes.php?city_link=constantine&box_style=2_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    Range("A1").Select
    Columns("A:A").ColumnWidth = 28.43
    Range("A1:A20").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
   
    Range("A1").Select
   
Dim nabil10 As String
Dim nabil11 As String
Dim nabil12 As String
Dim nabil13 As String
Dim nabil14 As String
Dim nabil15 As String
Dim nabil16 As String
Dim nabil17 As String
Dim nabil18 As String
Dim nabil19 As String
Dim nabil20 As String

Sheets("Tmp").Select
nabil10 = Range("A2")
nabil11 = Range("A3")
nabil12 = Range("A4")
nabil13 = Range("A6")
nabil14 = Range("A7")
nabil15 = Range("A9")
nabil16 = Range("A11")
nabil17 = Range("A13")
nabil18 = Range("A15")
nabil19 = Range("A17")
nabil20 = Range("A19")

Sheets("M-salat").Select
Range("AC20") = nabil10
Range("AC21") = nabil11
Range("U14") = nabil12
Range("M17") = nabil13
Range("L20") = nabil14
Range("AK26") = nabil15
Range("AF26") = nabil16
Range("AA26") = nabil17
Range("V26") = nabil18
Range("Q26") = nabil19
Range("L26") = nabil20
       

' masquer les feuil 2+3
Sheets("Tmp").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Parametre").Select
ActiveWindow.SelectedSheets.Visible = False
   
   
Sheets("M-salat").Select
Range("P9").Select
       
End Sub




 

Aucun commentaire:

Enregistrer un commentaire

مواقيت الصلاة


Propellerads