E-Arşiv Faturayı excel'e aktarma.

[excelal]

.

 

[Haluk]

.... dolayısıyla sizden son bir ricam şu. html de görünen gereksiz boşuklarıda satır olarak çektirelim ben tasarıma gireyim. faturayı yazdıracağım zaman o gereksiz boşlukları siler yazdırırım.

Kodda, aşağıdaki satırı silin....

                If indexTable = 5 And j = 0 And tempData = Empty Then GoTo 10:

.

 

[Haluk]

Birde tarih formatını düz bir şekilde alıyor. Aralarda noktalama koymuyor. Buna formül ile çözüm üretebilir miyiz?

Bunun için de, aşağıdaki satırı eskisiyle değiştirin...

        .Pattern = "[^A-Za-zĞÜŞİÖÇğüşıiöç0-9,\.\:\s\/%\-]"

.

 

[excelal]

Haluk bey, bahsettiğiniz satırlar ile ilgili silme ve değiştirme işlemini yaptım ve istediğim şekilde oldu, teşekkürler. yalnız şimdi öncekilerden farklı olarak sorgu ekranı çok uzun sürüyor. eğer logolar ile alakalı zaman kaybı oluyorsa onları silebiliriz. çünkü sayfa 1 de sadece bilgiler olması yeterli.
videosunu ekledim bakma imkanınız olurmu?

İndir bandicam 2020 468

Dosyayı indir bandicam 2020 468

dosya.co

 

[Haluk]

Logolardan dolayı sanmıyorum ama, eğer istemiyorsanız aşağıdaki satırları silin....

    Set Images = HTMLfile.getElementsByTagName("img")
    picBase64 = Replace(Images(0).src, "data:image/jpeg;base64,", "")
   
    tempPic1 = ThisWorkbook.Path & "\Temp1.jpg"
   
    Open tempPic1 For Binary As #1
       Put #1, 1, decodePic(picBase64)
    Close #1
   
    Range("E14").Select
    Set myPic = ActiveSheet.Pictures.Insert(tempPic1)
    myPic.Name = "Logo_EFatura"
   
    myPic.ShapeRange.LockAspectRatio = msoTrue
    myPic.Height = 40
   
    tempPic2 = ThisWorkbook.Path & "\Temp2.jpg"
   
    strSirketLogo = Range("O3") & Range("O4")
    Open tempPic2 For Binary As #1
       Put #1, 1, decodePic(strSirketLogo)
    Close #1
   
    Range("E4").Select
    Set myPic = ActiveSheet.Pictures.Insert(tempPic2)
    myPic.Name = "Logo_Sirket"
   
    myPic.ShapeRange.LockAspectRatio = msoTrue
    myPic.Height = 120
   
    Range("H1").Select

    Kill tempPic1
    Kill tempPic2
   
    Set myPic = Nothing
    Set Images = Nothing

ve;

Function decodePic(ByVal b64Pic As String) As Byte()
    Dim objXML As Object
    Dim objNode As Object

    Set objXML = CreateObject("MSXML2.DOMDocument")

    Set objNode = objXML.CreateElement("b64")
    objNode.DataType = "bin.base64"
    objNode.Text = b64Pic
    decodePic = objNode.nodeTypedValue

    Set objNode = Nothing
    Set objXML = Nothing
End Function

.

 

[excelal]

Kodları sildim, sorgulama yine çok uzun. sizin dediğiniz gibi logolardan değilmiş.

 

[excelal]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 <> Empty Then
For i = 16 To 35
If Cells(i, 1).Value = "" Then GoTo son
If Cells(i, 1).Value = 0 Then
Rows(i).EntireRow.Hidden = True
Else
son:
Rows(i).EntireRow.Hidden = False
End If
Next
End If
End Sub

HALUK bey bu kodu sayfa 2 ye ekledim, sayfa 1 den çektiğim ürün kısmındaki gereksiz boşlukları gizlesin diye. sayfa 1 de bilgileri html dosyasından çektirip sayfa 2 ye geçiyorum boşluklar gizlenmemiş ama sayfa 2 de 1nci sütunda 16 ile 35nci (yani duruma göre gizlenmesi gereken satırlar) hücrelerden herhangi birine çift tıklayıp herhangi bir şey yapmadan Enter lıyorum, gizlemeyi yapıyor. bunu otomatik yapsın istiyorum. yani o hücrelerin herhangi birine girip enterlamadan.

 

[Haluk]

Konu biraz eskidi, bir sürü dosya geldi gitti ..... ben olayı biraz unuttum.

Siz bu kodu 2. sayfaya taşıdığınız kodun sonuna bunları yazın, deneyin .... Muhtemelen ilk satırdaki "if target ...." ile başlayan satırı ve bu if'e tekabul eden en son "end if" satırını silmeniz gerekecek, bu şekilde deneyin....

.

 

[excelal]

Haluk bey dediğiniz şekilde yaptım hata verdi, ben dosyayı düzenleme yaptığım dosyayı ekledim, bakma imkanınız olurmu?. Haluk bey bir de sorgu çok uzun sürüyor, ona da bakabilir misiniz.

 

[Haluk]

Bilemiyorum .... bende hata oluşmadı, bütün işlemler 1 saniye bile sürmedi.

.

 

[excelal]

Anladım, teşekkür ederim.

 

[Haluk]

Siz bir de ekli dosyayı deneyin ..... satırların otomatik gizlenmesi iyileştirildi. Her 2 faturayı da ayrı ayrı deneyip, sonucu gözlemleyin.

.

 

[excelal]

Hocam çalıştır butonu çalışmıyor, bir eksiklikmi var anlayamadım.

 

[Haluk]

Valla eksiklik ..... sizin Excel'de sanırım.

Excel'i bilgisayardan kaldırıp, tekrar yükleyin bence.

.

 

[excelal]

Üstat videoda derdimi anlatmaya çalıştım. bakabilir misiniz?

İndir bandicam 2020 128

Dosyayı indir bandicam 2020 128

dosya.co

 

[Haluk]

Video'ya göre sizdeki bir Adobe yazılımı bir hataya yol açıyor.... bende öyle bir sıkıntı yok.

.

 

[excelal]

Üstat tamam çalıştı, sorunun kaynağı korumalı görünümün aktif olması kaynaklıymış. Tümünü devre dışı yapınca çalıştı. Enteresan olan önceki dosyalarda korumalı görünümde açılmıyorsu ama bunda sanırım bir kod korumalı görünümde açtırıyor.

**** Dipnot olsun diye yazdım. Saygılar...

 

[excelal]

Video'ya göre sizdeki bir Adobe yazılımı bir hataya yol açıyor.... bende öyle bir sıkıntı yok.

TempHD

Image TempHD hosted in Gifyu

gifyu.com

.

Birde bu ekran kayıtlarını hangi program ile gif yapıyorsun ben bandicam kullanıyorum ama gif yapmıyor. diğer videoların kayıtları büyük oluyor.

 

[Haluk]

LiceCAP

.

 

[excelal]

LiceCAP

.

Bu kadar kolay bir yöntem/program varken, Bandicam ile uğraşmaya değmezmiş.
Teşekkürler