sperimentare

conversione gradi con VBA su Excel

conversione gradi sessagesimali in g, p, s e viceversa
con VBA su excel
http://digilander.libero.it/francescovise/vbacodice/prove.htm
http://digilander.libero.it/francescovise/vbacodice/vbagradi.htm
http://digilander.libero.it/francescovise/vbacodice/vbagradi.xls

programma in VBA su excel per conversione gradi nei due formati
da gradi, primi, secondi a sessagesimale e viceversa

inserire valore in gradi, primi, secondi: 25° 40' 50''
i primi vengono divisi per 60 e trasformati in frazioni di grado 40/60
i secondi vengono divisi per 3600 e trasformati in frazioni di grado 50/3600
sommare gradi, primi e secondi trasformati per ottenere gradi sessagesimali 25° + (40/60)' + (50/3600)"

inserire gradi in forma sessagesimale( 45,34)°
ricavare la parte decimale e trasformarla in primi moltiplicando per 60 : 0.34*60 = (20.4)'
ricavare la parte decimale e trasformarla in secondi moltiplicando per 60:0.4*60 =(24)"
scrivere la parte intera dei gradi con la parte intera dei primi e con i secondi: 45° 20' 24"

copiare il codice , creare due pulsanti nel foglio excel, incollare i due codici nei pulsanti indicati
(per istruzioni vedi spiega1.htm)

Private Sub CommandButton1_Click()
Rem conversione gradi in formato sessagesimale
Cells(20, 1) = "inserire prima i dati richiesti"
Cells(21, 1) = "gradi, primi, secondi in B1,B2,B3"
Cells(22, 1) = "gradi sessagesimali ,con virgola, in B10"
Cells(23, 1) = "alla fine cliccare pulsante1"
Cells(1, 1) = "inserire gradi in 1,2"
Cells(2, 1) = "inserire primi in 2,2"
Cells(3, 1) = "inserire secondi in 3,2"
Cells(4, 1) = "conversione primi e secondi"
Cells(5, 1) = "primi/60 "
Cells(6, 1) = "secondi/3600"
Cells(7, 1) = "somma totale"
Cells(5, 2) = Cells(2, 2) / 60
Cells(6, 2) = Cells(3, 2) / 3600
Cells(7, 2) = Cells(1, 2) + Cells(5, 2) + Cells(6, 2)
Rem conversione da sessagesimale
Cells(10, 1) = "inserire gradi sessagesimali "
Cells(11, 1) = "parte decimale gradi e conversione in primi"
Cells(12, 1) = "parte decimale primi e conversione in secondi"
Cells(13, 1) = "nuovo formato"
Cells(11, 2) = Cells(10, 2) - Int(Cells(10, 2))
Cells(11, 3) = Cells(11, 2) * 60
Cells(12, 2) = Cells(11, 3) - Int(Cells(11, 3))
Cells(12, 3) = Cells(12, 2) * 60
Cells(14, 1) = "gradi"
Cells(15, 1) = "primi"
Cells(16, 1) = "secondi"
Cells(14, 2) = Int(Cells(10, 2))
Cells(15, 2) = Int(Cells(11, 3))
Cells(16, 2) = Cells(12, 3)
End Sub

Private Sub CommandButton2_Click()
Rem cancellazione dati
For riga = 1 To 16
Cells(riga, 2) = ""
Cells(riga, 3) = ""
Next riga
End Sub