DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Dim dosyahtml As String
Dim satir, kalemsatir As Long
Sub menu()
Call temizle
Call dosya_listesi
Call son_duzenleme
End Sub
Sub son_duzenleme()
Sheets("Liste").Select
sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
Range("J2:N" & sonsatir).Select
Selection.NumberFormat = "#,##0.00"
Columns("J:N").Select
Selection.Replace What:="TL", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("J" & sonsatir).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("J" & sonsatir).Select
Selection.AutoFill Destination:=Range("J" & sonsatir & ":N" & sonsatir), Type:=xlFillDefault
Range("J2:N" & sonsatir - 1).Select
For Each hucre In Selection
hucre.Value = 0 + hucre.Value
Next
Range("J2").Select
Sheets("FaturaKalem").Select
sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
Range("G2:H" & sonsatir).Select
Selection.NumberFormat = "#,##0.00"
Range("M2:M" & sonsatir).Select
Selection.NumberFormat = "#,##0.00"
Columns("G:M").Select
Selection.Replace What:="TL", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("G:M").Select
Selection.Replace What:=" TRY", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("E" & sonsatir).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("H" & sonsatir).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("M" & sonsatir).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("G2:H" & sonsatir - 1, "M2:M" & sonsatir - 1).Select
For Each hucre In Selection
hucre.Value = 0 + hucre.Value
Next
Range("J2").Select
End Sub
Sub temizle()
sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
If sonsatir = 1 Then sonsatir = 2
Range("A2:Q" & sonsatir).ClearContents
End Sub
Sub dosya_listesi()
yol = ActiveWorkbook.Path
filtre = yol & "\*.html"
dosya = Dir(filtre)
satir = 1
While dosya <> ""
dosyahtml = yol & "\" & dosya
satir = satir + 1
Call bilgi_al
dosya = Dir
Wend
kalemsatir = 2
sonsatir = Sheets("FaturaKalem").Cells(Rows.Count, "A").End(3).Row
If sonsatir = 1 Then sonsatir = 2
Sheets("FaturaKalem").Range("A2:Q" & sonsatir).ClearContents
dosya = Dir(filtre)
While dosya <> ""
dosyahtml = yol & "\" & dosya
Call kalem_al
dosya = Dir
Wend
End Sub
Sub kalem_al()
Dim URL As String
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim TDelements As IHTMLElementCollection
Dim TDelement As HTMLTableCell
Dim r As Long
URL = dosyahtml
Set IE = New InternetExplorer
Set shkalem = Sheets("FaturaKalem")
With IE
.navigate URL
.Visible = True
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
Set HTMLdoc = .document
End With
Set TDelements = HTMLdoc.getElementsByTagName("TD")
r = 0
verial = False
faturatarihial = False
faturanoal = False
For Each TDelement In TDelements
gecici = Trim(TDelement.innerText)
If gecici = "Fatura Tarihi :" And faturatarihial = False Then
faturatarihial = True
GoTo son
End If
If faturatarihial Then
faturatarihi = gecici
faturatarihial = False
End If
If gecici = "Fatura No:" And faturanoal = False Then
faturanoal = True
GoTo son
End If
If faturanoal Then
faturanoal = False
faturano = gecici
End If
If verial = False Then
If InStr(gecici, "Net Tutar") > 0 Then
verial = True
GoTo son
End If
End If
If verial Then
If InStr(gecici, "Toplam Iskonto") > 0 Then GoTo bitti
shkalem.Cells(kalemsatir, 1).Value = faturatarihi
shkalem.Cells(kalemsatir, 2).Value = faturano
r = r + 1
shkalem.Cells(kalemsatir, r + 2).Value = TDelement.innerText
If r Mod 11 = 0 Then
r = 0
kalemsatir = kalemsatir + 1
End If
End If
'verial = False
son:
Next
bitti:
IE.Quit
If shkalem.Cells(kalemsatir, 3) = "" Then
shkalem.Cells(kalemsatir, 1).Clear
shkalem.Cells(kalemsatir, 2).Clear
End If
End Sub
Sub bilgi_al()
Dim URL As String
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim TDelements As IHTMLElementCollection
Dim TDelement As HTMLTableCell
Dim r As Long
URL = dosyahtml
Set IE = New InternetExplorer
With IE
.navigate URL
.Visible = True
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
Set HTMLdoc = .document
End With
Set TDelements = HTMLdoc.getElementsByTagName("TD")
r = 0
verial = False
For Each TDelement In TDelements
gecici = Trim(TDelement.innerText)
If verial = False Then
If gecici = "Fatura Saati:" Then verial = True
If gecici = "Fatura Tarihi :" Then verial = True
If gecici = "Sipariş Tarihi:" Then verial = True
If gecici = "ERP Fatura No:" Then verial = True
If gecici = "VKN / TCKN :" Then verial = True
If gecici = "Toplam Iskonto" Then verial = True
If gecici = "Net Toplam Tutar" Then verial = True
If gecici = "KDV Matrahi (%18)" Then verial = True
If gecici = "Genel Toplam" Then verial = True
If gecici = "KDV Tutari (%18)" Then verial = True
If gecici = "Fatura No:" Then verial = True
If gecici = "Fatura No:" Then verial = True
If gecici = "Vergi Dairesi:" Then verial = True
If gecici = "Yaziyla Toplam Tutar" Then verial = True
If gecici = "Tasima No:" Then verial = True
GoTo son
End If
If verial Then
r = r + 1
Cells(satir, r).Value = TDelement.innerText
End If
verial = False
son:
Next
IE.Quit
End Sub
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend