Belirli Kolonları XML e aktarma

[ercanborais]

Selamlar Arkadaşlar,

Malum excelde yazılım güncelleme vs olmuyor... Ürün tablomuz var ürün ismi, maliyeti vs bunlar hep aynı... Biz excelde değişiklik yapıyoruz (tasarım, içerik vs) neredeyse her 3 ayda bir.. fakat ürün kodu, ürün ismi ve maliyet vs değişmiyor.... hesaplama alanları değişiyor sadece... Biz buton yapıp XML e aktar dediğimizde ürün kodları,ürün isimleri ve maliyetleri vs XML e aktarsın istiyoruz... Yeni exceli açınca orada da xml den aktar olacak... oraya bastığımızda o xml deki verileri anyı şekilde yapıştıracak...

Ben şehir isim ve plaka olarak yaptım deneme için.

İndir XML Aktarma xlsx

Dosyayı indir XML Aktarma xlsx

dosya.co

En azından bu şekilde her yeni excelde excelden excele kopyala yapıştır yapmamış oluruz...

Şimdiden Allah razı olsun destekleriniz için...

Saygılarımla,

(umarım böyle bişey mümkündür bilmiyorum)

 

[ismailem]

Sub XML_Aktar()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Urunler")

Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

Dim xmlDoc As Object, root As Object, urun As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")

Set root = xmlDoc.createElement("Urunler")
xmlDoc.appendChild root

Dim i As Long
For i = 2 To lastRow
Set urun = xmlDoc.createElement("Urun")

urun.appendChild xmlDoc.createElement("UrunKodu")
urun.LastChild.Text = ws.Cells(i, "A").Value

urun.appendChild xmlDoc.createElement("UrunAdi")
urun.LastChild.Text = ws.Cells(i, "B").Value

urun.appendChild xmlDoc.createElement("Maliyet")
urun.LastChild.Text = ws.Cells(i, "C").Value

root.appendChild urun
Next i

xmlDoc.Save ThisWorkbook.Path & "\Urunler.xml"
MsgBox "XML Aktarımı Tamamlandı", vbInformation

End Sub

Sub XML_Iceri_Aktar()

Dim xmlDoc As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")

xmlDoc.Load ThisWorkbook.Path & "\Urunler.xml"

Dim urunler As Object
Set urunler = xmlDoc.SelectNodes("//Urun")

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Urunler")

ws.Range("A2:C" & ws.Rows.Count).ClearContents

Dim i As Long
For i = 0 To urunler.Length - 1
ws.Cells(i + 2, 1).Value = urunler(i).SelectSingleNode("UrunKodu").Text
ws.Cells(i + 2, 2).Value = urunler(i).SelectSingleNode("UrunAdi").Text
ws.Cells(i + 2, 3).Value = urunler(i).SelectSingleNode("Maliyet").Text
Next i

MsgBox "XML'den Aktarım Tamamlandı", vbInformation

End Sub

 

[ercanborais]

Kardeşim Allah senden razı olsun.... Çok teşekkürler...

 

[relaxim]

Merhabalar,

Öğrenmek için soruyorum.
Yeni exceli açınca orada da xml den aktar olacak... oraya bastığımızda o xml deki verileri anyı şekilde yapıştıracak...
Bunu nasıl yapacaksınız anlatabilir misiniz? Benimde listem var başka excel dosyalarında kullanmam lazım...