arkadaşlar excelden başka bir yere komut verecek ve text dosyası olarak yazdırılacak bir macro yazdım.hatayı bulamıyorum.loop without do diyor.
bilmediğim bi kural mı var acaba.kodu yazıyorum:
excel dosyası da ektedir.
Sub CommandButton1_Click()
Open "C:\Program Files\IBM\Client Access\Emulator\Private\adj.mac" For Output As #1
i = 8
j = 1
tırnak = Sheet1.Cells(1, 8)
Print #1, "description="
Sheet1.Cells(j, 9) = "description="
j = j + 1
Do While Not IsEmpty(Cells(i, 1).Value)
Cells(i, 1).Select
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
GoTo samekey
Else
Print #1, "[pf1]]"
Sheet1.Cells(j, 9) = "[pf1]"
j = j + 1
End If
Print #1, tırnak & 3
Sheet1.Cells(j, 9) = tırnak & 3
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 5)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 5)
j = j + 1
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
j = j + 1
If Cells(i, 4).Value = "+" Then
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
ElseIf Cells(i, 4).Value = "-" Then
Print #1, tırnak & "-"
Sheet1.Cells(j, 9) = tırnak & "-"
j = j + 1
End If
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 1)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 1)
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 7)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 7)
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 6)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 6)
j = j + 1
Print #1, "[enter]"
Sheet1.Cells(j, 9) = "[enter]"
j = j + 1
samekey:
Print #1, tırnak & Sheet1.Cells(i, 2)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 2)
j = j + 1
Print #1, "[up]"
Sheet1.Cells(j, 9) = "[up]"
j = j + 1
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 5)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 5)
j = j + 1
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
j = j + 1
If Cells(i, 4).Value = "+" Then
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
ElseIf Cells(i, 4).Value = "-" Then
Print #1, tırnak & "-"
Sheet1.Cells(j, 9) = tırnak & "-"
j = j + 1
End If
Print #1, tırnak & 1
Sheet1.Cells(j, 9) = tırnak & 1
j = j + 1
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 5)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 5)
j = j + 1
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
j = j + 1
If Cells(i, 4).Value = "+" Then
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
ElseIf Cells(i, 4).Value = "-" Then
Print #1, tırnak & "-"
Sheet1.Cells(j, 9) = tırnak & "-"
j = j + 1
End If
Print #1, "[down]"
Sheet1.Cells(j, 9) = "[down]"
j = j + 1
'algoritma yaz buraya
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
a = Cells(i, 3).Value - 1600
If a <= 5 Then
For k = 1 To (2 * a) - 2
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Next k
If a > 5 Then
b = a / 5
c = Application.WorksheetFunction.RoundUp(, 0) 'yukarı yuvarlama
For l = 1 To c - 1
Print #1, "[down]"
Sheet1.Cells(j, 9) = "[down]"
j = j + 1
Next l
Dim MyResult
MyResult = a Mod 5 'a nın 5e bölümünden kalan
If MyResult = 1 Then GoTo quantitygir '5 ile bolumunden kalan 1 ise
Else
For m = 1 To (2 * a) - 2
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Next m
quantitygir:
Print #1, tırnak & Sheet1.Cells(i, 5)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 5)
j = j + 1
If Cells(i, 4).Value = "+" Then
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
ElseIf Cells(i, 4).Value = "-" Then
Print #1, tırnak & "-"
Sheet1.Cells(j, 9) = tırnak & "-"
j = j + 1
End If
Print #1, "[enter]"
Sheet1.Cells(j, 9) = "[enter]"
j = j + 1
Print #1, "[enter]"
Sheet1.Cells(j, 9) = "[enter]"
j = j + 1
i = i + 1
Loop
Close #1
End Sub
bilmediğim bi kural mı var acaba.kodu yazıyorum:
excel dosyası da ektedir.
Sub CommandButton1_Click()
Open "C:\Program Files\IBM\Client Access\Emulator\Private\adj.mac" For Output As #1
i = 8
j = 1
tırnak = Sheet1.Cells(1, 8)
Print #1, "description="
Sheet1.Cells(j, 9) = "description="
j = j + 1
Do While Not IsEmpty(Cells(i, 1).Value)
Cells(i, 1).Select
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
GoTo samekey
Else
Print #1, "[pf1]]"
Sheet1.Cells(j, 9) = "[pf1]"
j = j + 1
End If
Print #1, tırnak & 3
Sheet1.Cells(j, 9) = tırnak & 3
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 5)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 5)
j = j + 1
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
j = j + 1
If Cells(i, 4).Value = "+" Then
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
ElseIf Cells(i, 4).Value = "-" Then
Print #1, tırnak & "-"
Sheet1.Cells(j, 9) = tırnak & "-"
j = j + 1
End If
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 1)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 1)
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 7)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 7)
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 6)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 6)
j = j + 1
Print #1, "[enter]"
Sheet1.Cells(j, 9) = "[enter]"
j = j + 1
samekey:
Print #1, tırnak & Sheet1.Cells(i, 2)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 2)
j = j + 1
Print #1, "[up]"
Sheet1.Cells(j, 9) = "[up]"
j = j + 1
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 5)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 5)
j = j + 1
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
j = j + 1
If Cells(i, 4).Value = "+" Then
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
ElseIf Cells(i, 4).Value = "-" Then
Print #1, tırnak & "-"
Sheet1.Cells(j, 9) = tırnak & "-"
j = j + 1
End If
Print #1, tırnak & 1
Sheet1.Cells(j, 9) = tırnak & 1
j = j + 1
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
j = j + 1
Print #1, tırnak & Sheet1.Cells(i, 5)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 5)
j = j + 1
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
j = j + 1
If Cells(i, 4).Value = "+" Then
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
ElseIf Cells(i, 4).Value = "-" Then
Print #1, tırnak & "-"
Sheet1.Cells(j, 9) = tırnak & "-"
j = j + 1
End If
Print #1, "[down]"
Sheet1.Cells(j, 9) = "[down]"
j = j + 1
'algoritma yaz buraya
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
a = Cells(i, 3).Value - 1600
If a <= 5 Then
For k = 1 To (2 * a) - 2
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Next k
If a > 5 Then
b = a / 5
c = Application.WorksheetFunction.RoundUp(, 0) 'yukarı yuvarlama
For l = 1 To c - 1
Print #1, "[down]"
Sheet1.Cells(j, 9) = "[down]"
j = j + 1
Next l
Dim MyResult
MyResult = a Mod 5 'a nın 5e bölümünden kalan
If MyResult = 1 Then GoTo quantitygir '5 ile bolumunden kalan 1 ise
Else
For m = 1 To (2 * a) - 2
Print #1, "[tab field]"
Sheet1.Cells(j, 9) = "[tab field]"
j = j + 1
Next m
quantitygir:
Print #1, tırnak & Sheet1.Cells(i, 5)
Sheet1.Cells(j, 9) = tırnak & Sheet1.Cells(i, 5)
j = j + 1
If Cells(i, 4).Value = "+" Then
Print #1, "[field+]"
Sheet1.Cells(j, 9) = "[field+]"
ElseIf Cells(i, 4).Value = "-" Then
Print #1, tırnak & "-"
Sheet1.Cells(j, 9) = tırnak & "-"
j = j + 1
End If
Print #1, "[enter]"
Sheet1.Cells(j, 9) = "[enter]"
j = j + 1
Print #1, "[enter]"
Sheet1.Cells(j, 9) = "[enter]"
j = j + 1
i = i + 1
Loop
Close #1
End Sub