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!
|
