Koliko sam razumeo ti nemaš problem sa export u xml nego treba neka petlja u kojoj se poziva SnimiXML sa paremetrom fpath i file (ime fajla)
Izmeni SnimiXML tako da umesto prve dve linije prosleđuješ parametre
Napravi poziv SnimiXML unutar petlje po svim redovima iz Sheet1 od AS4 do kraja. Bilo bi lakše da se postavio primer, ali ovako napamet nešto kao
Code:
Option Explicit
Sub SnimiXML(fpath As String, fname As String)
Dim sh As Worksheet
' Startovati sa aktivnog lista
Set sh = ThisWorkbook.ActiveSheet
Dim folder As Variant
folder = Dir(fpath, vbDirectory)
' Ako ne postoji folder kreirati
If (folder = "") Then MkDir (fpath)
' Schema
Dim objMapToExport As XmlMap
Set objMapToExport = ActiveWorkbook.XmlMaps("RacunZahtjev_Map")
If objMapToExport.IsExportable Then
ActiveWorkbook.SaveAsXMLData fpath & "\" & fname & ".xml", objMapToExport
Else
MsgBox "Neodgovarajuća šema za eksport XML " & objMapToExport.Name
End If
End Sub
Sub Izvrsi()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim startRw As Long, endRw As Long, rw As Long
Dim fpath As String, fname As String
Set sh1 = ThisWorkbook.Sheets("Sheet1")
Set sh2 = ThisWorkbook.Sheets("Sheet2")
startRw = 4
endRw = sh1.Range("AS" & startRw).End(xlDown).Row
fpath = sh2.Range("I2").Value ' folder u koji se snima
fname = sh2.Range("I3").Value 'file u koji se snima
sh2.Activate ' Activira se sh2 da ne mora da se menja Snimi XML
For rw = startRw To endRw 'Petlja kroz popunjene ključeve
ActiveSheet.Range("F2").Value = sh1.Range("AS" & rw).Value
SnimiXML fpath, fname
Next rw
End Sub
Nije to loše Rembrante, samo što ne bi dodao još malo boje?