Tecnologia, programação e muito Visual FoxPro.

quarta-feira, 30 de setembro de 2009

Re: ]] XL-mania [[ konvert dari phone number ke huruf

 

Alternatif lain fungsi terbilang nomor telepon :

Function notelp(target As String) As String
'cara pemakaian =notelp(sel target)

Dim angka, teks As Variant
Dim x As Integer

angka = Split("( ) - 0 1 2 3 4 5 6 7 8 9")
teks = Split("Kurung.Buka Kurung.Tutup [Strip] Nol Satu Dua Tiga Empat
Lima Enam Tujuh Delapan Sembilan")

For x = 0 To 12
notelp = Trim(Replace(target, angka(x), teks(x) & " "))
target = notelp
Next

notelp = Replace(notelp, "Kurung.Buka", "[Kurung Buka]")
notelp = Replace(notelp, "Kurung.Tutup", "[Kurung Tutup]")

If notelp = "" Then: notelp = "Nomor yang anda panggil belum terpasang"

End Function

saya ambil dari blog ini :
http://pitikcilik.blogspot.com/2009/09/vba-excel-terbilang-untuk-nomor-telepon.html

On 9/30/09, Puthut Wibowo <puthut_vai@yahoo.com> wrote:
> Om om om........ kayak gini yak oom :
>
> 100 menjadi satu nol nol bukan seratus
>
> 1000 menjadi satu nol nol nol bukan seribu
>
> ini untuk merubah nomer hape ke huruf
>
> Gak Pake yang ada Pesen " Telpon Yang anda Tuju Belum Terpasang"
>
> Udah ane bikinin oom........tinggal rubah angka2x yang ada di dalam Cells
> hasil akan keluar berupa angka terbilang dalam bentuk dalam TEXT sesuai
> dengan keinginina oom.........Kodingangannya kayak gini oom :
> - Koding pada This Woorbook :
> Option Explicit
>
> Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
> On Error Resume Next
> Dim sHasil As String
> Dim wbSheet As Excel.Worksheet
>
>
> Dim x As String
>
> If Target.Column = 1 Then
>
> Set wbSheet = Sh
> Dim obj As New KelasTerbilang
> sHasil = obj.KonversiAngkaSatuan(Target.Text) ' kall Fungsi yang
> terdapat pada kelas
>
> wbSheet.Cells(Target.Row, 2) = Trim(sHasil) ' perlihatkan hasil
>
> Set wbSheet = Nothing
> End If
> End Sub
>
> - Koding Pada Kelas ( Nama Kelas : KelasTerbilang.cls )
> Option Explicit
>
> Dim Angka(0 To 9) As String
> Dim Angk, txt As String
> Dim n(9) As Integer
> Dim i As Integer
> Dim meValue As String
> Dim x
> Dim jumtxt As Integer
> Dim txtText As String
>
> Private Sub Class_Initialize() ' Kelas Init
> Angka(0) = "Nol"
> Angka(1) = " Satu "
> Angka(2) = " Dua"
> Angka(3) = " Tiga"
> Angka(4) = " Empat"
> Angka(5) = " Lima"
> Angka(6) = " Enam"
> Angka(7) = " Tujuh"
> Angka(8) = " Delapan"
> Angka(9) = " Sembilan"
> End Sub
>
> Public Function KonversiAngkaSatuan(Angk As String) As String
> meValue = "" ' Kosongkan !!! ha ha
>
> jumtxt = Len(Angk) ' Menghitung jumlah Looping
> txtText = Angk
>
> For i = 1 To jumtxt
> x = Mid(txtText, i, 1) ' he he he ;p
> meValue = Angka(x)
> KonversiAngkaSatuan = KonversiAngkaSatuan & " " & meValue ' He he
> ngakalin biar stringnya gak ketiban dan sejajar horizontal ;p Nyarinyee
> ampe 1 jam sendiri
> Next i
>
> End Function
>
>
> Hasilnya dapet di liat di attachment ooom (Makro nya oomm.... jangan Lupa )
>
>
> ~ ^ PUTHUT WIBOWO ^ ~
>
>
>
> --- On Wed, 9/30/09, hadysys <hadisys@pln.co.id> wrote:
>
> From: hadysys <hadisys@pln.co.id>
> Subject: ]] XL-mania [[ konvert dari phone number ke huruf
> To: XL-mania@yahoogroups.com
> Date: Wednesday, September 30, 2009, 4:45 PM
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
> suhu minta bantuan
>
> gimana caranya konversi angka ke huruf bukan terbilang loh ya ?
>
>
>
> misal
>
> 100 menjadi satu nol nol bukan seratus
>
> 1000 menjadi satu nol nol nol bukan seribu
>
> ini untuk merubah nomer hape ke huruf
>
>
>
> makasih atas bantuannya
>
>
>
> sys
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

__._,_.___
+-:: 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              |
+-------------------------------------------------------------------+
Recent Activity
Visit Your Group
Yahoo! Finance

It's Now Personal

Guides, news,

advice & more.

Yahoo! Groups

Mental Health Zone

Schizophrenia groups

Find support

Yahoo! Groups

Auto Enthusiast Zone

Love cars? Check out the

Auto Enthusiast Zone

.

__,_._,___

RE: [usuarios_fox] Consulta

 


Hola Arturo:

Puede ser por un archivo que no existe o por una ruta mal direccionada, porque no checas tu executable con el debuger paso a paso.

Tambien toma en cuenta que el instalador por default pone el ejecutable en archvis de programa.

Saludos Cordiales,

José Alfonso

To: usuarios_fox@yahoogrupos.com.mx
From: lobito_orihuela@hotmail.com
Date: Wed, 30 Sep 2009 19:26:21 +0000
Subject: RE: [usuarios_fox] Consulta

Amigo

Me parece que debes revisar por alli estas dejando una direccion fisica que no existe.

Saludos.

Alex.

To: zorrosmexicanos@googlegroups.com; usuarios_fox@yahoogrupos.com.mx

From: arturo.zamudio@gmail.com

Date: Tue, 29 Sep 2009 15:31:44 -0500

Subject: [usuarios_fox] Consulta

Buenas tardes, hice un programa en VPF8 e hice el instalador con el

InstallShield Express, pero cada que inicio el programa me sale la sig

leyenda: Error de programa, La ruta o el nombre del archivo no es valido y

las opciones cancelar, pasar por alto y ayuda.

Si le doy pasar por alto el programa corre bien, pero es molesto tener que

hacerlo. A alguno de ustedes les ha pasado eso??

Como podria quitar ese mensaje??

les envio un screenshoot del mensaje

gracias

[Se han eliminado los trozos de este mensaje que no contenían texto]



__________________________________________________________

¿Quieres ver los mejores videos de MSN? Enciende Messenger TV

http://messengertv.msn.com/mkt/es-es/default.htm

[Se han eliminado los trozos de este mensaje que no contenían texto]










__________________________________________________________
Si no está en Windows Live, nunca pasó
http://www.actualizatuperfil.com.mx/

[Se han eliminado los trozos de este mensaje que no contenían texto]

__._,_.___
Comentarios, observaciones o si deseas darte de baja avísame a: jamorquecho@hotmail.com

Actividad reciente
Visita tu grupo
Y! Respuestas

Pregunta

Gente real te

responde

Yahoo! Messenger

Mensajero perfecto

Llama de PC a PC

sin costo alguno

Barra Yahoo!

Todo a un clic

Acceso rápido a

servicios Yahoo!

.

__,_._,___

RE: [usuarios_fox] Consulta listados Visual FoxPro 9

 


Hola:

A ver si te entiendo, quieres generar una especie de Índice?

Digamos por cliente y el total de hojas?

Esto no lo he hecho pero si no me equivoco vfox 9 tiene la capacidad de interaccionar con los reportes, se me ocurre que se puede guardar unas variables con esa información.

Como bién dices los reportes son dinámicos en función del tipo de campo y la impresora, asi que esta información se tendría al final de la impresión, pero se puede hacer una corrida previa tipo preview.

Saludos Cordiales,

José Alfonso

To: usuarios_fox@yahoogrupos.com.mx
From: julio.dutto@sancor.com.ar
Date: Wed, 30 Sep 2009 07:16:25 -0300
Subject: [usuarios_fox] Consulta listados Visual FoxPro 9

Buenas, tengo una aplicación que genera un listado a partir de un grupo de

registros seleccionados que se alojan en una base de datos, hasta ahora el

listado funcionaba ok ya que no reviste grandes requisitos, la única

consideración que tiene que antes de generarse el listado se le debe

ingresar un número de hoja preimpresa y debe recuperar el último número de

hoja impresa para el cliente en cuestión, se trabaja con varios clientes,

el primer número es consecutivo para todos y el segundo es exclusivo y

consecutivo de cada cliente, otra consideración es que la cantidad de

líneas por hoja no siempre es el mismo, ya que hay un par de datos que

tienen longitud variable y por solicitud de quien lo encargó se tomó un

largo de impresión bastante Standard, 70% de las impresiones, cuando se

excede dicha longitud se continua la impresión en la línea siguiente, con

lo que se reducen las líneas de impresión por hoja.

El tema que necesito resolver es el siguiente, necesitan conocer por una

cuestión de practicidad, en que hoja (no rango) está impreso cada documento

listado, esto responde a que el requisito del mismo no es justamente el

documento, y se vuelve bastante engorroso encontrar rápidamente el doc

entre la información del listado, con lo que debería ir devolviendo la hoja

en que se van imprimiendo cada documento a la base para así cuando

necesitan recuperar el dato van directamente a la hoja impresa.

Gracias, saludos.

Conozca más sobre SanCor en http://www.sancor.com

Este mensaje y sus adjuntos son confidenciales y para uso exclusivo del destinatario arriba indicado. Quien lo recibiere por error, no tendrá derecho a usarlo o reenviarlo, de cualquier forma. No se garantiza seguridad o exactitud de la información y anexos, o la inexistencia de virus, atentos a la naturaleza abierta de las comunicaciones por Internet. Las opiniones y material del mensaje son responsabilidad del autor y emisor del mismo y no atribuibles al Grupo SanCor Cooperativas Unidas Limitada ni a ninguna de sus Empresas, salvo que ello surgiera fehacientemente del mensaje, y éste proviniera de un funcionario del citado Grupo con facultades para obligarlo y en ejercicio de sus funciones.










__________________________________________________________
Y tú, ¿ya actualizaste tu Perfil?
http://www.actualizatuperfil.com.mx/

[Se han eliminado los trozos de este mensaje que no contenían texto]

__._,_.___
Comentarios, observaciones o si deseas darte de baja avísame a: jamorquecho@hotmail.com

Actividad reciente
Visita tu grupo
Y! Respuestas

Pregunta

Gente real te

responde

Yahoo! Messenger

Mensajero perfecto

Llama de PC a PC

sin costo alguno

Barra Yahoo!

Todo a un clic

Acceso rápido a

servicios Yahoo!

.

__,_._,___

RE: [usuarios_fox] Consulta

 


Amigo

Me parece que debes revisar por alli estas dejando una direccion fisica que no existe.

Saludos.

Alex.


To: zorrosmexicanos@googlegroups.com; usuarios_fox@yahoogrupos.com.mx
From: arturo.zamudio@gmail.com
Date: Tue, 29 Sep 2009 15:31:44 -0500
Subject: [usuarios_fox] Consulta

Buenas tardes, hice un programa en VPF8 e hice el instalador con el
InstallShield Express, pero cada que inicio el programa me sale la sig
leyenda: Error de programa, La ruta o el nombre del archivo no es valido y
las opciones cancelar, pasar por alto y ayuda.
Si le doy pasar por alto el programa corre bien, pero es molesto tener que
hacerlo. A alguno de ustedes les ha pasado eso??
Como podria quitar ese mensaje??

les envio un screenshoot del mensaje

gracias

[Se han eliminado los trozos de este mensaje que no contenían texto]


__________________________________________________________
¿Quieres ver los mejores videos de MSN? Enciende Messenger TV
http://messengertv.msn.com/mkt/es-es/default.htm

[Se han eliminado los trozos de este mensaje que no contenían texto]

__._,_.___
Comentarios, observaciones o si deseas darte de baja avísame a: jamorquecho@hotmail.com

Actividad reciente
Visita tu grupo
Y! Respuestas

Pregunta

Gente real te

responde

Yahoo! Messenger

Mensajero perfecto

Llama de PC a PC

sin costo alguno

Barra Yahoo!

Todo a un clic

Acceso rápido a

servicios Yahoo!

.

__,_._,___

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!

__._,_.___
+-:: 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              |
+-------------------------------------------------------------------+
Recent Activity
Visit Your Group
Yahoo! Finance

It's Now Personal

Guides, news,

advice & more.

Weight Management Group

on Yahoo! Groups

Join the challenge

and lose weight.

Yahoo! Groups

Mental Health Zone

Bi-polar disorder

Find support

.

__,_._,___

Arquivo do blog