Attribute VB_Name = "maschera_input_valori_html"
'
Option Explicit
'
' vba - crea finestra per input valori utilizzando Internet Explorer
'
Sub uso_MaskHtml_usa_valori()
Dim campi, ritorno
campi = Array("", "codice", "descrizione", "prezzo")
ritorno = creaMaskeraHtml(campi)
'
Dim valori1, valori2, valori3
'
valori1 = ritorno(1)
valori2 = ritorno(2)
valori3 = ritorno(3)
'
MsgBox valori1 & vbCrLf & valori2 & vbCrLf & valori3
'
End Sub
'
'
Sub uso_MaskHtml_elenca_valori()
Dim campi, ritorno
campi = Array("", "codice", "descrizione", "note", "prezzo")
ritorno = creaMaskeraHtml(campi)
'
Dim conta, quanti
quanti = UBound(ritorno)
For conta = 1 To quanti
ActiveSheet.Cells(conta, "a").Value = campi(conta)
ActiveSheet.Cells(conta, "b").Value = ritorno(conta)
Next conta
'
End Sub
'
Function creaMaskeraHtml(campi)
'
On Error GoTo esci
'
Dim txtHtml, ie, valoriinput, quanticampi, contacampi
quanticampi = UBound(campi)
ReDim ritorno(quanticampi)
ritorno(0) = "errore"
'
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "about:blank"
ie.Top = 150
ie.Visible = True
ie.Height = 300
ie.Width = 550
ie.MenuBar = False
ie.Toolbar = False
ie.StatusBar = False
ie.resizable = True
'
ie.document.Title = " - inserimento valori - "
' crea codice HTML della pagina per input dei valori.
' utilizzando una form e una tabella
txtHtml = ""
txtHtml = txtHtml + "<html><body><center>"
txtHtml = txtHtml + " inserimento<br>"
txtHtml = txtHtml + "<FORM name=""mask""><table>"
For contacampi = 1 To quanticampi
txtHtml = txtHtml + "<TR>" ' crea nuova riga
txtHtml = txtHtml + "<TD>" ' crea colonna della descrizione
txtHtml = txtHtml + campi(contacampi) ' testo visualizzato
txtHtml = txtHtml + ":</TD><TD>" ' nuova colonna
txtHtml = txtHtml + "<input name=""" & campi(contacampi) & """ type=""text"" value="""">" ' box input
txtHtml = txtHtml + "</TD></TR>"
Next contacampi
txtHtml = txtHtml + "</table></FORM></body></html>"
ie.document.body.innerHTML = txtHtml
'
' Do While IE.readyState = 4: DoEvents: Loop
'
Do While ie.readyState = 4
'
contacampi = 0
For Each valoriinput In ie.document.all.tags("INPUT")
contacampi = contacampi + 1
ritorno(contacampi) = valoriinput.Value
Next
'
DoEvents
Loop
'
ritorno(0) = "risposta"
Set ie = Nothing
'
esci:
'
creaMaskeraHtml = ritorno
'
End Function
'
'
Nessun commento:
Posta un commento