runtime error 9 hatası

[ridvansahin]

Merhabalar,

Telefon rehberimi düzenlemek için oluşturduğum excel sayfasında a sütununda ( First Name ) b sütununda ( Last Name ) c sütununda ( Phone Number ) başlıkları bulunuyor ve toplam satır sayısı 2043 . vba ya eklediğim kod bu şekilde ; ne yaptıysam run-time error '9' : subscript out of range hatasından kurtulamadım. iphone a vcf leri aktarmaya çalışıyorum. Makro dan anlayan biri değilim. youtube ta izleyerek yapmaya çalışıyorum.

şimdiden teşekkürler.

Private Sub Create_VCF()
'Open a File in Specific Path in Output or Append mode
Dim FileNum As Integer
Dim iRow As Double
iRow = 2
FileNum = FreeFile
OutFilePath = "D:\OutputVCF.VCF"
Open OutFilePath For Output As FileNum

'Loop through Excel Sheet each row and write it to VCF File
While VBA.Trim(Sheets("Sheet1").Cells(iRow, 1)) <> ""
LName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
FName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 2))
PhNum = VBA.Trim(Sheets("Sheet1").Cells(iRow, 3))

Print #FileNum, "BEGIN:VCARD"
Print #FileNum, "VERSION:3.0"
Print #FileNum, "N:" & LName & ";" & FName & ";;;"
Print #FileNum, "FN:" & LName & " " & FName
Print #FileNum, "TEL;TYPE=CELL;TYPE=PREF:" & PhNum
Print #FileNum, "END:VCARD"
iRow = iRow + 1
Wend

'Close The File
Close #FileNum
MsgBox "Contacts Converted to Saved To: " & OutFilePath & "
End Sub

 

[muhasebeciyiz]

VBA kodunuzda, "run-time error '9': subscript out of range" hatası alıyorsunuz. Bu hata, döngünün Sheet1 sayfasından veri okumaya çalışırken bir hücreye erişmeye çalıştığında ve o hücrenin var olmadığında oluşur.Çalışma kitabınızda "Sheet1" adlı bir sayfanın olduğundan emin olun. Bu adla bir sayfa yoksa, hatayla karşılaşırsınız.

Private Sub Create_VCF()

Dim FileNum As Integer
Dim iRow As Double
Dim ws As Worksheet
Dim OutFilePath As String
Dim LName As String
Dim FName As String
Dim PhNum As String

iRow = 2
FileNum = FreeFile
OutFilePath = "D:\OutputVCF.VCF"
Open OutFilePath For Output As FileNum

On Error Resume Next
Set ws = Sheets("Sheet1")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Sheet1 bulunamadı. Lütfen sayfa adını kontrol edin."
Exit Sub
End If

While VBA.Trim(ws.Cells(iRow, 1)) <> ""
LName = VBA.Trim(ws.Cells(iRow, 1))
FName = VBA.Trim(ws.Cells(iRow, 2))
PhNum = VBA.Trim(ws.Cells(iRow, 3))

Print #FileNum, "BEGIN:VCARD"
Print #FileNum, "VERSION:3.0"
Print #FileNum, "N:" & LName & ";" & FName & ";;;"
Print #FileNum, "FN:" & LName & " " & FName
Print #FileNum, "TEL;TYPE=CELL;TYPE=PREF:" & PhNum
Print #FileNum, "END:VCARD"
iRow = iRow + 1
Wend
Close #FileNum
MsgBox "Contacts Converted to Saved To: " & OutFilePath
End Sub

 

[ridvansahin]

VBA kodunuzda, "run-time error '9': subscript out of range" hatası alıyorsunuz. Bu hata, döngünün Sheet1 sayfasından veri okumaya çalışırken bir hücreye erişmeye çalıştığında ve o hücrenin var olmadığında oluşur.

Sub Create_VCF()

Dim FileNum As Integer
Dim iRow As Long

iRow = 2
FileNum = FreeFile
OutFilePath = "D:\OutputVCF.VCF"
Open OutFilePath For Output As FileNum

While VBA.Trim(Sheets("Sheet1").Cells(iRow, 1)) <> ""
LName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
FName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 2))
PhNum = VBA.Trim(Sheets("Sheet1").Cells(iRow, 3))

Print #FileNum, "BEGIN:VCARD"
Print #FileNum, "VERSION:3.0"
Print #FileNum, "N:" & LName & ";" & FName & ";;;"
Print #FileNum, "FN:" & LName & " " & FName
Print #FileNum, "TEL;TYPE=CELL;TYPE=PREF:" & PhNum
Print #FileNum, "END:VCARD"

iRow = iRow + 1
Wend

Close #FileNum

MsgBox "Kişiler Dönüştürüldü ve Kaydedildi: " & OutFilePath
End Sub

tamamdır hallettim. teşekkür ederim