Excelden xml'e veri aktarma.

S

sarman61

Katılım
4 Eylül 2007
Mesajlar
85
Excel Vers. ve Dili
eXCELL 2007
Merhaba arkadaşlar forumda bu konu üzerine açılan çoğu konuyu inceledim ama bir türlü aradığım cevabı bulamadım. Çoğu arkadaşımız ssk nın sitesinde verilen örnekle git dedi onun üzerinden gitmeye çalışsam da çok karışık bir işlevi olduğu için ben kavrayamadım. Yani en azından mantığı gösterilse belki kavrarım. Şimdi elimde şöyle bir xml örneği var aşağıdaki gibi. Excel de sıralı yazan metinleri ben nasıl xml çevirebilirim. Saygılarımla

Kod: 
 <?xml version="1.0" encoding="utf-8" ?> 
- <Kitaplar>
- <Kitap>
  <Ad>Siyah Süt</Ad> 
  <Bilgi>''Siyah Süt, cesur, sasirtici, tilsimli bir roman: Bunca kötülügün ortasinda, bize umut veriyor Elif Safak, dayanabilmek, direnebilmek ve sonra hayata, bir mucize gibi, yeniden baslayabilmek için.''<br /> <br /></Bilgi> 
  <ISBN>9759915315</ISBN> 
  <YayinYili>2008</YayinYili> 
  <SayfaSayisi>308</SayfaSayisi> 
  <Ebat>13,5x19,5 cm</Ebat> 
  <Cevirmen /> 
  <Stok>7</Stok> 
  <ParaBirimi>10</ParaBirimi> 
  <YayinEviID>498</YayinEviID> 
  <Fiyat>17</Fiyat> 
  <IndirimOran>10</IndirimOran> 
  <AnindaKargo>10</AnindaKargo> 
- <Yazarlar>
- <Yazar>
  <YazarID>11128</YazarID> 
  <Tipi>10</Tipi> 
  </Yazar>
  </Yazarlar>
- <Fotograflar>
- <Fotograflar>
- <Fotograf>
  <DosyaAdi>Blue hills.jpg</DosyaAdi> 
  <DosyaYolu>~/Files/KitapTemp/Blue hills.jpg</DosyaYolu> 
  </Fotograf>
- <Fotograf>
  <DosyaAdi>Blue hills.jpg</DosyaAdi> 
  <DosyaYolu>~/Files/KitapTemp/Blue hills.jpg</DosyaYolu> 
  </Fotograf>
  </Fotograflar>
  </Fotograflar>
- <Kategoriler>
- <Kategori>
  <KategoriID>-1</KategoriID> 
  <SiraNo>1</SiraNo> 
  </Kategori>
- <Kategori>
  <KategoriID>-100</KategoriID> 
  <SiraNo>1</SiraNo> 
  </Kategori>
  </Kategoriler>
  </Kitap>
  </Kitaplar>
 

Ekli dosyalar

S

sarman61

Katılım
4 Eylül 2007
Mesajlar
85
Excel Vers. ve Dili
eXCELL 2007
Kod: 
Sub XML_Hazirla()
Dim xmlStr As String
Dim TAB1 As String

TAB1 = Chr$(9)
'On Error Resume Next
hata_yok = True
belge5510Sonrasidir = False
Call donem5510OncemiSonramidir

Call Input_Check
If hata_yok Then
   Call Sirala
   Open ActiveSheet.Range("J3").Value For Output As #1
   If Err <> O Then
       MsgBox ("Verilen Dosya Adı Hatalı. (Örnek: c:\bordro112003.xml)")
       Exit Sub
   End If
   xmlStr = "<?xml version=""1.0"" encoding=""iSO-8859-9""?>"
   Print #1, xmlStr
   xmlStr = "<AYLIKBILDIRGELER>"
   Print #1, xmlStr
   xmlStr = TAB1 & "<ISYERI ISYERISICIL=" & """" & ActiveSheet.Range("E2").Value & """ " & _
                   "KONTROLNO=" & """" & ActiveSheet.Range("H2").Value & """ " & _
                   "ISYERIARACINO=" & """" & ActiveSheet.Range("E3").Value & """ " & _
                   "ISYERIUNVAN=" & """" & ActiveSheet.Range("E4").Value & """ " & _
                   "ISYERIADRES=" & """" & ActiveSheet.Range("E5").Value & """ "
   If (Trim(ActiveSheet.Range("E6").Value) <> "") Then
       xmlStr = xmlStr & "ISYERIVERGINO=" & """" & ActiveSheet.Range("E6").Value & """"
   End If
   xmlStr = xmlStr & "/>"

   Print #1, xmlStr
   xmlStr = TAB1 & "<BORDRO DONEMAY=" & """" & ActiveSheet.Range("E9").Value & """ " & _
                   "DONEMYIL=" & """" & ActiveSheet.Range("E8").Value & """ " & _
                   "BELGEMAHIYET=" & """" & ActiveSheet.Range("E10").Value & """/>"
   Print #1, xmlStr
   
   

   RowInd = SigBasSatir: PrevBC = "": PrevK = "": IlkGiris = True
   ActiveSheet.Range("C" & Mid$(Str(RowInd), 2)).Select
   Sigortalı_Sira = 0
   While ActiveCell.Value <> ""
       BC = ActiveSheet.Range("C" & Mid$(Str(RowInd), 2)).Value
       KANUN = ActiveSheet.Range("D" & Mid$(Str(RowInd), 2)).Value
       SICIL = ActiveSheet.Range("E" & Mid$(Str(RowInd), 2)).Value
       TCK = ActiveSheet.Range("F" & Mid$(Str(RowInd), 2)).Value
       Ad = ActiveSheet.Range("G" & Mid$(Str(RowInd), 2)).Value
       Soyad = ActiveSheet.Range("H" & Mid$(Str(RowInd), 2)).Value
       ILKSOY = ActiveSheet.Range("I" & Mid$(Str(RowInd), 2)).Value
       PEK = ActiveSheet.Range("J" & Mid$(Str(RowInd), 2)).Value
       Gun = ActiveSheet.Range("K" & Mid$(Str(RowInd), 2)).Value
       
       GGUN = ActiveSheet.Range("L" & Mid$(Str(RowInd), 2)).Value
       CGUN = ActiveSheet.Range("M" & Mid$(Str(RowInd), 2)).Value
       UIG = ActiveSheet.Range("N" & Mid$(Str(RowInd), 2)).Value
       UIPEK = ActiveSheet.Range("O" & Mid$(Str(RowInd), 2)).Value
       EGN = ActiveSheet.Range("P" & Mid$(Str(RowInd), 2)).Value
       ICN = ActiveSheet.Range("Q" & Mid$(Str(RowInd), 2)).Value
       If ((IsNumeric(GGUN)) And (Val(GGUN) < 1)) Then
          GGUN = ""
       End If
       If ((IsNumeric(CGUN)) And (Val(CGUN) < 1)) Then
          CGUN = ""
       End If
       If ((IsNumeric(UIG)) And (Val(UIG) < 1)) Then
          UIG = ""
       End If
       If ((IsNumeric(UIPEK)) And (Val(UIPEK) < 1)) Then
          UIPEK = ""
       End If
       If ((IsNumeric(EGN)) And (Val(EGN) < 1)) Then
          EGN = ""
       End If
       If ((IsNumeric(ICN)) And (Val(ICN) < 1)) Then
          ICN = ""
       End If
       
       
       If ((BC <> PrevBC) Or (KANUN <> PrevK)) Then
         If Not IlkGiris Then
            xmlStr = TAB1 & TAB1 & "</SIGORTALILAR>"
            Print #1, xmlStr
            xmlStr = TAB1 & "</BILDIRGELER>"
            Print #1, xmlStr
         End If
         IlkGiris = False
         PrevBC = BC
         PrevK = KANUN
         xmlStr = TAB1 & "<BILDIRGELER BELGETURU=" & """" & BC & """" & " KANUN=" & """" & KANUN & """>"
         Print #1, xmlStr
         xmlStr = TAB1 & TAB1 & "<SIGORTALILAR>"
         Print #1, xmlStr
         Sigortalı_Sira = 0
       End If
       Sigortalı_Sira = Sigortalı_Sira + 1
       SIRA = Sigortalı_Sira
       xmlStr = TAB1 & TAB1 & TAB1
       xmlStr = xmlStr & "<SIGORTALI SIRA=" & """" & SIRA & """ "
       If SICIL <> "" Then
          xmlStr = xmlStr & "aaaSIGORTALISICIL=" & """" & SICIL & """ "
       End If
       If TCK <> "" Then
          xmlStr = xmlStr & "TCKNO=" & """" & TCK & """ "
       End If
       xmlStr = xmlStr & "AD=" & """" & Ad & """ "
      ' xmlStr = xmlStr & "AD=" & """" & UTF8_CONV(AD) & """ "
       xmlStr = xmlStr & "SOYAD=" & """" & Soyad & """ "
       If ILKSOY <> "" Then
           xmlStr = xmlStr & "ILKSOYAD=" & """" & ILKSOY & """ "
       End If
       xmlStr = xmlStr & "PEK=" & """" & PEK & """ "
       xmlStr = xmlStr & "GUN=" & """" & Gun & """ "
       If GGUN <> "" Then
           xmlStr = xmlStr & "GIRISGUN=" & """" & GGUN & """ "
       End If
       If CGUN <> "" Then
           xmlStr = xmlStr & "CIKISGUN=" & """" & CGUN & """ "
       End If
       If UIG <> "" Then
           xmlStr = xmlStr & "UCRETLIIZINGUN=" & """" & UIG & """ "
       End If
       If UIPEK <> "" Then
           xmlStr = xmlStr & "UIPEK=" & """" & UIPEK & """ "
       End If
       If EGN <> "" Then
           xmlStr = xmlStr & "EKSIKGUNNEDENI=" & """" & EGN & """ "
       End If
       If ICN <> "" Then
           xmlStr = xmlStr & "ISTENCIKISNEDENI=" & """" & ICN & """"
       End If
       xmlStr = xmlStr & "/>"
       Print #1, xmlStr
    
       RowInd = RowInd + 1
       ActiveSheet.Range("C" & Mid$(Str(RowInd), 2)).Select
   Wend
   xmlStr = TAB1 & TAB1 & "</SIGORTALILAR>"
   Print #1, xmlStr
   xmlStr = TAB1 & "</BILDIRGELER>"
   Print #1, xmlStr
   xmlStr = "</AYLIKBILDIRGELER>"
   Print #1, xmlStr
   Close #1
   MsgBox ("XML Dosya Hazırlandı")
Else
'   If Hata_Satir = 0 Then
'      MsgBox (Hata_Mesaj)
'   Else
      MsgBox ("***Sıra:" + Str(Hata_Satir) + "***" + Hata_Mesaj)
'   End If
End If
End Sub
Bu kod üzerinde nasıl bir değişiklik yapmam gerekiyor. Yada burda ki kodlardan hangisi benim işime görür nereye odaklanmam gerekiyor yardımcı olabilirmisiniz. Saygılarımla
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst