Skip to main content

AccessTr.neT


Userformdan Hücre Değerini Checkbox İle Geçici Olarak Değiştirmek.

Oğuz Türkyılmaz
Oğuz Türkyılmaz
9
195

Userformdan Hücre Değerini Checkbox İle Geçici Olarak Değiştirmek.

#7
@feraz hocam yardımlarınız için teşekkür ederim. Konuyu taşıyabilirsiniz.
Kod
Type KaydetmeAlani
    val As Variant
    addr As String
End Type

Public arr() As KaydetmeAlani
Public awn As String
Public aws As String

Sub MakroCalistir_2()
    Dim say As Integer
    awn = ActiveCell.Parent.Parent.Name
    aws = ActiveCell.Parent.Name
    
    ReDim Preserve arr(1 To 33)
    
    Dim i As Integer
    With Sayfa1
        For i = 22 To 54
            say = say + 1
            If .Range("M" & i).Interior.ColorIndex = 7 Then
                arr(say).addr = Sayfa1.Cells(i, "M").Address
                arr(say).val = Sayfa1.Cells(i, "M").Formula
                If frm_bioclimatic.CheckBox2.Value = True Then .Cells(i, "M").Value = 0
                
            End If
        Next
    End With

End Sub
Sub MakroGeriAl_2()
    Dim j As Integer
    For j = LBound(arr) To UBound(arr)
        If Len(arr(j).addr) > 0 Then Sayfa1.Range(arr(j).addr).Formula = arr(j).val
    Next j
End Sub
Access Çekirgesi 
[Resim: img-cray.gif]


Cevapla
#8
(13/09/2021 23:21)Oğuz Türkyılmaz Adlı Kullanıcıdan Alıntı: @feraz hocam yardımlarınız için teşekkür ederim. Konuyu taşıyabilirsiniz.
Kod
Type KaydetmeAlani
    val As Variant
    addr As String
End Type

Public arr() As KaydetmeAlani
Public awn As String
Public aws As String

Sub MakroCalistir_2()
    Dim say As Integer
    awn = ActiveCell.Parent.Parent.Name
    aws = ActiveCell.Parent.Name
    
    ReDim Preserve arr(1 To 33)
    
    Dim i As Integer
    With Sayfa1
        For i = 22 To 54
            say = say + 1
            If .Range("M" & i).Interior.ColorIndex = 7 Then
                arr(say).addr = Sayfa1.Cells(i, "M").Address
                arr(say).val = Sayfa1.Cells(i, "M").Formula
                If frm_bioclimatic.CheckBox2.Value = True Then .Cells(i, "M").Value = 0
                
            End If
        Next
    End With

End Sub
Sub MakroGeriAl_2()
    Dim j As Integer
    For j = LBound(arr) To UBound(arr)
        If Len(arr(j).addr) > 0 Then Sayfa1.Range(arr(j).addr).Formula = arr(j).val
    Next j
End Sub
Rica ederim.
Cevapla
#9
(13/09/2021 23:21)Oğuz Türkyılmaz Adlı Kullanıcıdan Alıntı: awn = ActiveCell.Parent.Parent.Name aws = ActiveCell.Parent.Name
Aslında buraya gerek yok ben silmeyi unutmuşum.
O kodlar sayda aktif yapılınca için geçerliydi onu silmiştim.Zten koddada bu kodlar geçersiz Img-grin
Cevapla
#10
Kodu böyle kullanın abey.Arr içinede aralık yazmaya gerek yok aslında 1 to 1  yeterli.

Visual Basic Code
Sub MakroCalistir_2()
    Dim say As Integer, i As Long
    
    ReDim arr(1 To 1)
    
    With Sayfa1
        For i = 22 To 54
            say = say + 1
            ReDim Preserve arr(1 To say)
            If .Range("M" & i).Interior.ColorIndex = 7 Then
                arr(say).addr = .Cells(i, "M").Address
                arr(say).val = .Cells(i, "M").Formula
                If frm_bioclimatic.CheckBox2.Value = True Then .Cells(i, "M").Value = 0
            End If
        Next
    End With
End Sub
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da