Hot Fox: Re: Bls: ]] XL-mania [[ Masalah Data Validation

om om om, inti pertanyaannya sebenarnya

......... :

" Bagaimana supaya jika user melakukan copy dr [Cells Sumber] sebagai sumber kemudian melakukan paste ke [Cells Target] , maka yang di paste (Klik Kanan PASTE SPESIAL maupun PASTE BIASA ( Ctrl+V ) hanya nilai nya saja sehingga format [Cells Sumber] tetap numerik. dalam artian disini PASTESPESIAL VALUE DOANK......."

Ok.... oom ini Bisa dilakukan

dengan menggunakan MAKRO VBA Pada Excel......dengan Kriteria, Sbb :

"Di Wookbook Ini, Fungsi kopi (kosongan ataupun mengandung formula) akan di PASTE Selalu Menghasilkan PASTE SPESIAL VALUE DOANK meskipun dengan menggunakan PASTE BIASA-BUKAN SPESIAL........Di setiap WoorkSheet di dalam Woorkbook ini"

Sehingga Cells Target Paste yang Mengandung Data Validation ataupun Format CellsTIDAK TERHAPUS Karena Paste Spesial Value Doank...

Aturan Main

: Dengan mematikan "CUT" dan Merubah PASTE (Ctrl + V) Menjadi PASTE SPESIAL VALUE DOANK.....Bisa dengan Menggunakan :

--> Klik Kanan Kopi (Ctrl+C)Pada Sumber dan Klik Kanan Paste Biasa (Ctrl + V) Pada Target Cells tapi menghasilkan PASTE SPESIAL VALUE

Untuk Kodingannya OOmmm (File Terlampir) Agak Banyak OOmmm

saya menggunakan Excel 2003(Gak tau kalo di 07 jalan gak) :

- Koding Pada This Woorkbook :
Option Explicit
Private Sub Workbook_Activate()
    Debug.Print "Workbook_Activate"
    ForcePasteSpecial
End Sub

Private Sub Workbook_Deactivate()
    Debug.Print "Workbook_Deactivate"
    ReleasePasteControl
End Sub

- Koding Pada Modul:

Option Explicit
Option Private Module
Option Compare Binary
Private m_oPasteFile As Object
Private Const m_sFSO_c As String = "Scripting.FileSystemObject"
Private Const m_sPasteProcedure_c As String = "PasteSpecial"
Private Const m_sUbndoProcedure_c As String = "UndoPasteSpecial"
Private Const m_sCutWarningProcedure_c As String = "CutWarning"
Private m_oWS As Excel.Worksheet
'Microsoft Scripting Runtime Constants:
Private Const TristateTrue As Long = -1
Private Const ForReading As Long = 1
Private Const ForWriting As Long = 2
Private Const TemporaryFolder As Long = 2
'Error Handling Constants:
Private Const m_sTitle_c As String = "Error Number: "
Private Const m_lButtons_c As Long = vbExclamation + vbMsgBoxSetForeground + vbMsgBoxHelpButton
'Interface Control Constants:
Const m_sTag_c As String = "ForcePaste"
' ********************************************************************************************
Public Sub ForcePasteSpecial()
    LockInterface
    Excel.Application.OnKey "^v", m_sPasteProcedure_c
    Excel.Application.OnKey "+{INSERT}", m_sPasteProcedure_c
    Excel.Application.OnKey "^x", m_sCutWarningProcedure_c
    ReplacePasteButtons
    CutButtonsEnable False
Exit_Proc:
    On Error Resume Next
    UnlockInterface
    Exit Sub
Err_Hnd:
    VBA.MsgBox VBA.Err.Description, m_lButtons_c, m_sTitle_c & CStr(VBA.Err.Number), VBA.Err.HelpFile, VBA.Err.HelpContext
    Resume Exit_Proc
End Sub
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Paste Dijalankan ..............
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Sub ReleasePasteControl()
    On Error GoTo Err_Hnd
    LockInterface
    Excel.Application.OnKey "^v"
    Excel.Application.OnKey "+{INSERT}"
    Excel.Application.OnKey "^x"
    RestorePasteButtons
    CutButtonsEnable True
Exit_Proc:
    On Error Resume Next
    m_oPasteFile.Delete True
    UnlockInterface
    Exit Sub
Err_Hnd:
    VBA.MsgBox VBA.Err.Description, m_lButtons_c, m_sTitle_c & CStr(VBA.Err.Number), VBA.Err.HelpFile, VBA.Err.HelpContext
    Resume Exit_Proc
End Sub
' ********************************************************************************************

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Paste Spesial
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub PasteSpecial()
    On Error GoTo Err_Hnd
    Dim bRunOnce As Boolean
    Dim oFSO As Object
    Dim oTS As Object
    Dim oCll As Excel.Range
    Dim oDataRng As Excel.Range
    Dim lLstRow As Long
    Dim sTmpPth As String
    Const lPasteError_c As Long = 1004
    Const lFNFError_c As Long = 53
    LockInterface
    If Excel.ActiveWorkbook Is Excel.ThisWorkbook Then
        Set oFSO = VBA.CreateObject(m_sFSO_c)
        If m_oPasteFile Is Nothing Then
CreateFile:
            sTmpPth = oFSO.BuildPath(oFSO.GetSpecialFolder(TemporaryFolder), oFSO.GetTempName)
        Else
            sTmpPth = m_oPasteFile.ShortPath
        End If
        If oFSO.FileExists(sTmpPth) Then oFSO.DeleteFile sTmpPth, True
        oFSO.CreateTextFile sTmpPth, True, True
        Set m_oPasteFile = oFSO.GetFile(sTmpPth)
        Set oTS = m_oPasteFile.OpenAsTextStream(ForWriting, TristateTrue)
        Set oDataRng = Excel.ActiveSheet.UsedRange
        lLstRow = oDataRng.Row
        oTS.WriteLine oDataRng.Address
        For Each oCll In oDataRng.Cells
            If lLstRow <> oCll.Row Then
                lLstRow = oCll.Row
                oTS.Write vbNewLine
            End If
            oTS.Write oCll.Formula & vbTab
        Next oCll
        Set m_oWS = Excel.ActiveSheet
        Excel.Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, True, False
        Excel.Application.OnUndo "&Undo Paste", m_sUbndoProcedure_c
    Else
        Excel.ActiveSheet.Paste
    End If
Exit_Proc:
    On Error Resume Next
    oTS.Close
    UnlockInterface
    Exit Sub
Err_Hnd:
    Select Case VBA.Err.Number
        Case lPasteError_c
            If Not bRunOnce Then
                bRunOnce = True
                VBA.Err.Clear
                If Excel.Application.Dialogs(xlDialogPasteSpecial).Show Then
                    Resume Next
                Else
                    Resume Exit_Proc
                End If
            End If
        Case lFNFError_c
            Resume CreateFile
    End Select
    VBA.MsgBox VBA.Err.Description, m_lButtons_c, m_sTitle_c & CStr(VBA.Err.Number), VBA.Err.HelpFile, VBA.Err.HelpContext
    Resume Exit_Proc
    Resume
End Sub

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Batalkan Paste Spesial
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub UndoPasteSpecial()
    On Error GoTo Err_Hnd
    Dim oTS As Object
    Dim lRow As Long
    Dim lCol As Long
    Dim vLine As Variant
    Dim sAddress As String
    Dim lColOffset As Long
    Const lLimit_c As Long = 256
    Const lStep_c As Long = 1
    Const lZero_c As Long = 0
    Const lOffset_c As Long = 1
    LockInterface
    If m_oPasteFile Is Nothing Then
        VBA.Err.Raise vbObjectError, m_sUbndoProcedure_c, "Cannot find stored paste data. Procedure cannot be reveresed."
    End If
    Set oTS = m_oPasteFile.OpenAsTextStream(ForReading, TristateTrue)
    If Not oTS.AtEndOfStream Then
        sAddress = oTS.ReadLine
        With m_oWS.Range(sAddress)
            lColOffset = .Column
            lRow = .Row
        End With
    End If
    m_oWS.UsedRange.ClearContents
    Do Until oTS.AtEndOfStream
        vLine = VBA.Split(oTS.ReadLine, vbTab, lLimit_c, vbBinaryCompare)
        For lCol = lZero_c To UBound(vLine)
            If VBA.IsNumeric(vLine(lCol)) Then
                m_oWS.Cells(lRow, lCol + lColOffset).Formula = CDbl(vLine(lCol))
            Else
                m_oWS.Cells(lRow, lCol + lColOffset).Formula = vLine(lCol)
            End If
        Next
        lRow = lRow + lStep_c
    Loop
Exit_Proc:
    On Error Resume Next
    oTS.Close
    UnlockInterface
    Exit Sub
Err_Hnd:
    VBA.MsgBox VBA.Err.Description, m_lButtons_c, m_sTitle_c & CStr(VBA.Err.Number), VBA.Err.HelpFile, VBA.Err.HelpContext
    Resume Exit_Proc
    Resume
End Sub

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Merubah me.popup Paste Biasa menjadi Paste Spesial
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Private Sub ReplacePasteButtons()
    On Error GoTo Err_Hnd
    Dim oPasteBtns As Office.CommandBarControls
    Dim oPasteBtn As Office.CommandBarButton
    Dim oNewBtn As Office.CommandBarButton
    Const lIDPaste_c As Long = 22
    RestorePasteButtons
    Set oPasteBtns = Excel.Application.CommandBars.FindControls(ID:=lIDPaste_c)
    For Each oPasteBtn In oPasteBtns
        Set oNewBtn = oPasteBtn.Parent.Controls.Add(msoControlButton, Before:=oPasteBtn.Index, Temporary:=True)
        oNewBtn.FaceId = lIDPaste_c
        oNewBtn.Caption = oPasteBtn.Caption
        oNewBtn.TooltipText = oPasteBtn.TooltipText
        oNewBtn.Style = oPasteBtn.Style
        oNewBtn.BeginGroup = oPasteBtn.BeginGroup
        oNewBtn.Tag = m_sTag_c
        oNewBtn.OnAction = m_sPasteProcedure_c
        oPasteBtn.Visible = False
    Next
    Exit Sub
Err_Hnd:
    VBA.MsgBox VBA.Err.Description, m_lButtons_c, m_sTitle_c & CStr(VBA.Err.Number), VBA.Err.HelpFile, VBA.Err.HelpContext
End Sub

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Kembalikan me.popup Paste Biasa
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Private Sub RestorePasteButtons()
    On Error GoTo Err_Hnd
    Dim oBtns As Office.CommandBarControls
    Dim oBtn As Office.CommandBarButton
    Const lIDPaste_c As Long = 22
    Const m_sTag_c As String = "ForcePaste"
    Set oBtns = Excel.Application.CommandBars.FindControls(ID:=lIDPaste_c)
    For Each oBtn In oBtns
        oBtn.Visible = True
    Next
    Set oBtns = Excel.Application.CommandBars.FindControls(Tag:=m_sTag_c)
    If Not oBtns Is Nothing Then
        For Each oBtn In oBtns
            oBtn.Delete
        Next
    End If
    Exit Sub
Err_Hnd:
    VBA.MsgBox VBA.Err.Description, m_lButtons_c, m_sTitle_c & CStr(VBA.Err.Number), VBA.Err.HelpFile, VBA.Err.HelpContext
End Sub

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Merubah Button Cut menjadi Enabeld (Berfungsi)
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Private Sub CutButtonsEnable(EnableButton As Boolean)
    On Error GoTo Err_Hnd
    Dim oCutBtns As Office.CommandBarControls
    Dim oCutBtn As Office.CommandBarButton
    Const lIDCut_c As Long = 21
    Set oCutBtns = Excel.Application.CommandBars.FindControls(ID:=lIDCut_c)
    For Each oCutBtn In oCutBtns
        oCutBtn.Enabled = EnableButton
    Next
    Exit Sub
Err_Hnd:
    VBA.MsgBox VBA.Err.Description, m_lButtons_c, m_sTitle_c & CStr(VBA.Err.Number), VBA.Err.HelpFile, VBA.Err.HelpContext
End Sub

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Pelanggaran Cut karena nekat digunakan (^o^) ho ho ho
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub CutWarning()
On Error Resume Next
    VBA.MsgBox "Kegunaan ""[Cut]"" tidak dapat digunakan di Woorkbook ini.", vbInformation + vbMsgBoxSetForeground, "Cut Dimatikan"
End Sub

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Mengunci Aplikasi Excel yang sedang digunakan
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub LockInterface()
    With Excel.Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Cursor = xlWait
        .EnableCancelKey = xlErrorHandler
    End With
End Sub
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Membuka Aplikasi Excel yang sedang digunakan
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub UnlockInterface()
    With Excel.Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Cursor = xlDefault
        .EnableCancelKey = xlInterrupt
    End With
End Sub

Semoga Sesuai Dengan Harapan Si oom...........

~ ^ Puthut Wibowo ^ ~

--- On Sat, 9/26/09, Ruud wong <ruud_mail2007@yahoo.co.id> wrote:

From: Ruud wong <ruud_mail2007@yahoo.co.id>
Subject: Bls: ]] XL-mania [[ Masalah Data Validation
To: XL-mania@yahoogroups.com
Date: Saturday, September 26, 2009, 11:53 AM

terima kasih atas bantuan semuanya.

to siti vi: makro yang anda berikan tidak bekerja setelah saya coba, anyway terimakasih atas bantuannya.

sebenernya yang saya butuhkan adalah bagaimana agar jika user melakukan copy paste, maka secara otomatis/by default user sebenernya cuma bisa melakukan paste special values. jadi format maupun validasi dari sumber daya ygn dicopy tidak ikut terbawa saat paste.

misalkan :

cell A1 tipenya sudah diformat sebagai numerik dan divalidasi nilai yang valid adalah
1 s/d 10.

cell B1 tipe datanya adalah text dan nilainya sembarang nilai(alfanumerik) .

masalahnya adalah bagtaimana supaya jika user melakukan copy dr cell B1 sebagai sumber kemudian melakukan paste ke A1, maka yang di paste (klik kanan paste maupun ctrl-v) hanya nilai nya saja sehingga format celll A1 tetap numerik.

mohon bantuan rekan2 sekalian.

terima kasih.

Dari: siti Vi <setiyowati.devi@ gmail.com>
Kepada: XL-mania@yahoogroup s.com
Terkirim: Jumat, 25 September, 2009 20:26:10
Judul: Re: ]] XL-mania [[ Masalah Data Validation

setelah kolom diberi validasi spt itu
untuk mencegah NON Number masuk (walaupun dengan cara di copy paste)
worksheets perlu diberi sedikit makro (di module sheet ybs)
makro yg ditulis hendaknya MAU otomatis jalan jika cell di kolom tsb berubah nilainya
(memamfaatkan event wokbuk_ching)

inti kerjaan makro-nya
* jika data yg dicopykan bukan NUMBER maka langsung di hapus
* jika data berupa bertype numbers, ya di diamkan saja

Private Sub Worksheet_Change( ByVal Target As Range)
Dim Cel As Range
If Target.Column = 1 Then
For Each Cel In Target
If Not WorksheetFunction. IsNumber( Cel.Value) Then Cel.ClearContents
Next Cel
End If
End Sub

mengenai: apakah numbers yg dicopy paste-kan tsb berada dlm rentang angka 1 - 10;
data validation lah yg akan mengurusnya.

(note :kayaknya isnumber dari woksit tidak sama kerjanya dng isnumeric dari vba)

ctv

2009/9/23 ruud_mail2007 <ruud_mail2007@ yahoo.co. id>
>
> hai semuanya,
> saya saat ini sedang menalami masalah dengan data validation microsoft excel.
>
> begini masalahnya:
> saya memformat cell A1 dengan tipe number dan memberikan data validation pada cell itu bahawa data yang valid adalah 1 s/d 10.
> kemudian saya melakukan protect sheet agar data validation yang telah saya buat tidak bisa di edit oleh orang lain.
> ketika saya mengetikkan nilai pada cell A1, data validation berjalan dengan baik, tetapi ketika saya melakukan copy n paste ke cell itu (misalkan nilai "coba") maka data validation seolah2 tidak bekerja karena nilai "coba" yang saya masukkan ke cell A1 tidak di tolak.
> ketika saya teliti lagi bahwa copy n paste yang saya lakukan telah merubah format cell yang telah saya setting sebelumnya dari numerik menjadi text.
>
> pertanyaan saya adalah:
> 1. bagaimana supaya ketika user melakukan copy n paste dari file excel lain maka data validation saya tetap bekerja.
> 2. bagaimana supaya ketika user malakukan copy paste tidak merubah format cell yang telah saya buat sebelumnya.
>
> terima kasih
>

Menambah banyak teman sangatlah mudah dan cepat.
Undang teman dari Hotmail, Gmail ke Yahoo! Messenger sekarang!

__._,_.___

Messages in this topic (10) Reply (via web post) | Start a new topic

Messages

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Tolong cariin momods kerjaan jadi direktur dongggg... :D :D :D    |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf          |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/           |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html           |
+-------------------------------------------------------------------+
| Message lama ada di :                                             |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com              |
+-------------------------------------------------------------------+

MARKETPLACE

Mom Power: Discover the community of moms doing more for their families, for the world and for each other

Change settings via the Web (Yahoo! ID required)
Change settings via email: Switch delivery to Daily Digest | Switch format to Traditional
Visit Your Group | Yahoo! Groups Terms of Use | Unsubscribe

__,_._,___

Hot Fox

quarta-feira, 30 de setembro de 2009

Re: Bls: ]] XL-mania [[ Masalah Data Validation

Nenhum comentário:

Arquivo do blog