otomatik çift tıklama???

[iaydin20]

merhaba;
arkadaşlar excel dosyasını açtığımda belirlediğim bir hücreyi makroyla otomatik çift tıklansın istiyorum böyle bir kod varmı acaba ne için istediğimi soracak olursanız internetten döviz bilgisi alan bir dosya ver elimde ve bu dosya güncelleştirme yapmak için a1 hücresine çift tıklamam gerekiyor bunu otomatik yapmasını istiyorum çünki excel sayfaları gözükmeyecek ve sadece userform üzerinde çalışacağı yardımcı olacak arkadaşlara teşekkürü bir borç bilirim...

 

[cry_of_dark]

veriyi aktaracagınız sayfanın kod sayfasına aşagıdaki kodları kopyalayın

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Application.ScreenUpdating = False
If Target = "" Then Exit Sub
If Intersect(Target, [a:a]) Is Nothing Then Exit Sub
Set s1 = Sheets("veri")
Set s2 = Sheets("işlem")
son = s2.Cells(65536, 1).End(3).Row + 1
s2.Range("a" & son & ":h" & son & "").Value = Range("a" & Target.Row & ":h" & Target.Row & "").Value
Target.Offset(1, 0).Select
Set s1 = Nothing
Set s2 = Nothing
Application.ScreenUpdating = True
MsgBox "a dan h ye veri aktarıldı"
End Sub

veriyi akatarcagınız sayfa adına veri aktarmayı yapmak istediğiniz sayfa adına ise işlem adını veriniz ( değiştirebilirsiniz)
Aktarma sayfasına a dan h sütününa kadar bilgi giriniz.
kolay gelsin

 

[iaydin20]

hocam ben anlayamadım ya karıştırdım bi örnekle açıklayabilirmisiniz.rica etsem teşekkürler..

 

[cebir]

merhaba..
bir modül ekleyip.(dosyanızı açtığınızda bilgileri getirmesi için)

Sub Autpen()
Sheets("Sayfa1").select'veya istediğiniz sayfa

'internetten bilgi getiren kodlarınız

End Sub

veya (a1 e tıklamak istediğiniz) button a kodlarınızı
yazsanız bir sakınca olurmu

 

[iaydin20]

sıkıntımı anlatamadım galiba bana sadece açılışta a1 hücresine çift tıklayacak bi makro lazım...yinede teşekkürler...

 

[Korhan Ayhan]

Selamlar,

Döviz bilgilerini alan kodlarınızı verirseniz düzenleme yapabiliriz.

 

[iaydin20]

hocam dosya ekte kodlar vba da döviz sayfasının içinde

 

[iaydin20]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Application.Intersect(Target, [A1,A2]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Cancel = True
Set s1 = Sheets("döviz")
Set s2 = Sheets("KURLAR")
TARİH = Date

s2.Cells.Delete
Application.StatusBar = "Kur bilgileri alınıyor. Lütfen bekleyiniz..."
s2.Select

With Application
.DecimalSeparator = "."
.ThousandsSeparator = ","
.UseSystemSeparators = False
End With

On Error GoTo HATA

With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.tcmb.gov.tr/yeni/tablolar.php", Destination:=s2.[A1])
.Name = "KURLAR"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

With Application
.UseSystemSeparators = True
End With

s2.[B:C].NumberFormat = "#,##0.0000"
s2.[c1] = Date = s1.[a7]
s2.[c1].NumberFormat = "m/d/yyyy"

s1.Select
If Target.Address = "$A$1" Then
Target.Offset(0, 1) = s2.[B4]
Target.Offset(1, 1) = s2.[B3]
ElseIf Target.Address = "$A$2" Then
Target.Offset(0, 1) = s2.[B3]
Target.Offset(-1, 1) = s2.[B4]
End If

Set s1 = Nothing
Set s2 = Nothing
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox Format(TARİH, "dd.mm.yyyy") & " tarihli T.C.M.B. kur bilgileri başarıyla alınmıştır.", vbInformation, "Dikkat !"
Exit Sub

HATA:
s1.Select
With Application
.UseSystemSeparators = True
End With
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "İnternet bağlantısı şu anda kurulamıyor." & vbCrLf & "Lütfen daha sonra tekrar deneyin.", vbCritical, "UYARI !"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[Korhan Ayhan]

Selamlar,

Sn. cebir beyin belirttiği gibi kodları dosyanın açılış bölümüne yazarsanız istediğiniz sonuca ulaşabilirsiniz. Ekteki örnek dosyayı incelermisiniz.

 

[iaydin20]

hocam teşekkür ederim emeğinize sağlık