İşletim sistemi değişikliğinden sonra makro kodları çalışmıyor.

[kadir78]

İyi günler. Aşağıdaki kodlar Windows 7 kurulu iken sorunsuz çalışıyordu. Windows 10 yüklendikten sonra Sendkeys satırları çalışmıyor. Aynı hücre içerisinde döngü yapıyor. Sorunu çözmede yardımcı olur musunuz.

Sub Aktama()

Set s1 = Sheets("Bilgiler")
Set s2 = Sheets("Etiket")

If s1.Range("E1").Value = "" Then
Else
s2.Activate
a = s1.[C1] & "-" & s1.[E1]
ActiveCell.Value = a
Application.Wait Now() + TimeValue("00:00:01")
[COLOR="Red"]SendKeys "{RIGHT}", True[/COLOR]
End If

If s1.Range("F1").Value = "" Then
Else
s2.Activate
a = s1.[C1] & "-" & s1.[F1]
ActiveCell.Value = a
Application.Wait Now() + TimeValue("00:00:01")
[COLOR="Red"]SendKeys "{RIGHT}", True[/COLOR]
End If

If s1.Range("G1").Value = "" Then
Else
s2.Activate
a = s1.[C1] & "-" & s1.[G1]
ActiveCell.Value = a
Application.Wait Now() + TimeValue("00:00:01")
[COLOR="Red"]SendKeys "{RIGHT}", True[/COLOR]
End If

If s1.Range("H1").Value = "" Then
Else
s2.Activate
a = s1.[C1] & "-" & s1.[H1]
ActiveCell.Value = a
Application.Wait Now() + TimeValue("00:00:01")
[COLOR="Red"]SendKeys "{RIGHT}", True[/COLOR]
End If

If s1.Range("I1").Value = "" Then
Else
s2.Activate
a = s1.[C1] & "-" & s1.[I1]
ActiveCell.Value = a
Application.Wait Now() + TimeValue("00:00:01")
[COLOR="Red"]SendKeys "{RIGHT}", True[/COLOR]
End If

If s1.Range("J1").Value = "" Then
Else
s2.Activate
a = s1.[C1] & "-" & s1.[J1]
ActiveCell.Value = a
Application.Wait Now() + TimeValue("00:00:01")
[COLOR="Red"]SendKeys "{RIGHT}", True[/COLOR]
End If

s2.PrintOut

Application.DisplayAlerts = False
Application.Quit

End Sub

 

[askm]

Dosyanızı ekleyin başka bir çözüm bulalım. Sendkeysi en son çözüm olarak deneyin.

 

[kadir78]

Dosyayı ekledim. Ekteki dosyada sayfalar korumalı ve şifre yok.
https://www.dosyaupload.com/hTqR

 

[kadir78]

Sayın Hocalarım. Bu konuda yardımcı olur musunuz.

 

[kadir78]

Arkadaşlar konu hakkında yardımcı olur musunuz. İyi günler.