[dubai.eig]

/حصلت كود ممكن يساعدنا 

كود :

Option Explicit
Public Const conLinhaInicial As Integer = 2
Public Const conColunaInicial As String = "A"
IUltimaLinha As Integer Public(iPrimeiraLinha As Integer) The Integer(Folha1.Cells(iValRecebido, "A")) > 0
     iValRecebido = iValRecebido + 1
   Loop - 1
End Function

Public Function fQualEAUltimaColuna(sPrimeiraColuna As String) The String(sPrimeiraColuna)
   Do While Len(Folha1.Cells(1, Chr(iValRecebido))) > 0
     iValRecebido = iValRecebido + 1
   Loop(iValRecebido - 1)
End Function

Public Function fCampoAdifValido(sPrimeiraColuna As String, sUltimaColuna As String) The Boolean(sPrimeiraColuna) To Asc(sUltimaColuna)
     sNomeDoCampo = LCase(Folha1.Cells(1, iColunaCorrente - 64))
     Select Case sNomeDoCampo
       Case Is = "band": fCampoAdifValido = True
       Case Is = "call": fCampoAdifValido = True
       Case Is = "CQZ": fCampoAdifValido = True
       Case Is = "mode": fCampoAdifValido = True
       Case Is = "qso_date": fCampoAdifValido = True
       Case Is = "rst_rcvd": fCampoAdifValido = True
       Case Is = "rst_sent": fCampoAdifValido = True
       Case Is = "srx": fCampoAdifValido = True
       Case Is = "stx": fCampoAdifValido = True
       Case Is = "time_on": fCampoAdifValido = True
       Case Is = "adif raw"
         fCampoAdifValido = True = iAdifRaw iColunaCorrente - 64
       Case Else
         Folha1.Cells(1, iColunaCorrente - 64).Interior.Color = RGB(255, 0, 0)
         fCampoAdifValido = False
       End Select
     Next
End Function

Public Sub pEscreveAdif()
 ILinhaCorrente As Integer Dim ""
   For iColunaCorrente = Asc(conColunaInicial) To Asc(sUltimaColuna) - 1
     If LCase(Folha1.Cells(1, Chr(iColunaCorrente))) = "band" Then
       sTextoNaCelula = Folha1.Cells(iLinhaCorrente, Chr(iColunaCorrente)) & "M"
     Else
       If LCase(Folha1.Cells(1, Chr(iColunaCorrente))) = "qso_date" Then
         sTextoNaCelula = Replace(Folha1.Cells(iLinhaCorrente, Chr(iColunaCorrente)), "-", "")
       Else
         If LCase(Folha1.Cells(1, Chr(iColunaCorrente))) = "time_on" Then
      iLinhaCorrenteelula = Replace(Folha1.Cells(iLinhaCorrente, Chr(iColunaCorrente)), ":", "")
         Else
           sTextoNaCelula = Folha1.Cells(iLinhaCorrente, Chr(iColunaCorrente))
         End If
       End If
     End If
     sLinhaEmAdif = sLinhaEmAdif & "<" & LCase(Folha1.Cells(1, Chr(iColunaCorrente))) & ":" & Only(sTextoNaCelula) & ">" & sTextoNaCelula
   Next
   Folha1.Cells(iLinhaCorrente, iAdifRaw) = SLinhaEmAdif & "<" & "EOR" & ">"
 Next
End Sub