Visual Basic

Re: search a excel document

2-Apr-13 9:13

You should take a look at this first:
http://support.microsoft.com/kb/301982[^]

If you know that, then I would suggest a very simple search in a table/array or list would do just fine.

Maciej Los10-Apr-13 3:38

Maciej Los

10-Apr-13 3:38

What have you done so far? Where are you stuck?

Do you want to do that with VBA, VB.NET, C#, any???

Re: search a excel document

Maciej Los10-Apr-13 5:10

Maciej Los

10-Apr-13 5:10

VBA for Excel. Data stored in Sheet1, columns: A - CODE, B - NAME. Searches for files in the same folder in which is stored workbook.

Option Explicit

Sub ChangeTheNamesOfFiles()
Dim wsh As Worksheet
Dim sInitialPath As String, sOldName As String, sNewName As String, sExt As String
Dim i As Integer

sInitialPath = ThisWorkbook.Path & "\"
sExt = ".txt"
Set wsh = ThisWorkbook.Worksheets(1)
i = 2
Do While wsh.Range("A" & i)
    sOldName = wsh.Range("A" & i)
    sOldName = FindFile(sInitialPath, sOldName, sExt)
    sNewName = sInitialPath & wsh.Range("B" & i) & sExt
    If sOldName <> "" Then
        FileCopy sOldName, sNewName
        Kill sOldName
    End If

Loop


End Sub


Function FindFile(ByVal sDir As String, ByVal sFileName As String, Optional ByVal sFileExt As String = ".txt") As String
Dim retVal As String

If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
retVal = Dir(sDir & sFileName & sFileExt, vbNormal)

FindFile = retVal

End Function

Maciej Los

Searching Data

Ahmad Rifai Yusuf2-Apr-13 3:45

Ahmad Rifai Yusuf

2-Apr-13 3:45

Dear all,

I'am trying to build a search program using Excel 2003 Macro, i have trouble when i click this command always shown this message : "Run Time Error '1004': Application-defined or object-defined error".

Need your help to check where the wrong syntax code of my program,

Private Sub cmdCari_Click()
Set wsDtbsCont = Sheets("DataContainer")
Set rgDtbsCont = wsDtbsCont.Range("DataContainer")
Set c = rgDtbsCont.Find(txtContNo.Value, LookIn:=xlValues)
txtCarrier.Value = c.Offset(0, 1).Value
cmbForwarder.Value = c.Offset(0, 2).Value
txtSeal.Value = c.Offset(0, 3).Value
txtStatus.Value = c.Offset(0, 4).Value
txtArrivalTime.Value = c.Offset(0, 5).Value
txtStuffingTime.Value = c.Offset(0, 6).Value
txtSealTime.Value = c.Offset(0, 7).Value
txtFreeTime.Value = c.Offset(0, 8).Value
txtOverNight.Value = c.Offset(0, 9).Value
End Sub

thank you for every things..

Best Regards,

Ahmad Rifai Yusuf

Re: Searching Data

Kenneth Haugland2-Apr-13 9:15

Hello All, need help to SET 5 days in a weeks in VB 2010 EXPRESS

2-Apr-13 9:15

The range definition looks stange to me, can you use select all or something like that? I m assuming that your sheet actually excist though, or?

Re: Searching Data

Ahmad Rifai Yusuf3-Apr-13 13:01

Ahmad Rifai Yusuf

3-Apr-13 13:01

Dear Kenneth,

The sheet actually exist, i'am trying to search data with cmdCari Command Button with where the key is in txtContNo Text Box,

Actually i was interested use select or other SQL Statement, but don't have any references. Do you / any guys have it. Coz i really need it

Best Regards,

Ahmad Rifai Yusuf

Yazid Aura Robbani1-Apr-13 22:08

Yazid Aura Robbani

1-Apr-13 22:08

sorry if my English is not good.
5 Days need to set name is :
Day1 = Legi
Day2 = Pahing
Day3 = Pon
Day4 = Wage
Day5 = Kliwon

I have the Code in VB6 with 1 form and 2 modules and I have no problem with it, but when i try to put this code on VB 2010 I completely have HEADACHE CODE Smile | :)

'Form1
------

Dim ahari
Dim shari As String
Dim l As Single
Dim l1 As Single
Dim CekTanggal As Boolean
Dim HariIni As Boolean
Public TextTanggalSekarang As String
Const MaxTahun = 2099, MinTahun = 1901

Private Sub CmbTahun_Click()
    If CekTanggal = False Then
        Exit Sub
    End If
    TampilkanTanggal
End Sub
Private Sub CmbBulan_Click()
    If CekTanggal = False Then
        Exit Sub
    End If
    TampilkanTanggal
End Sub

Private Sub Form_Load()
    If App.PrevInstance = True Then
        Unload Me
        End
    End If
    
    CekTanggal = False
    Combo_Status_Load
    Combo_Tahun_Load
    TanggalSekarang = Now
    CmbBulan.ListIndex = Month(TanggalSekarang) - 1
    CmbTahun.ListIndex = Year(TanggalSekarang) - MinTahun
    HariIni = True
    TampilkanTanggal
    CekTanggal = True
    formloaded = True
    Timer1.Interval = 300
ahari = Array("Minggu", "Senin", "Selasa", "Rabu", "Kamis", "Jumat", "Sabtu")

End Sub

Private Sub Combo_Status_Load()
    CmbBulan.List(0) = "Januari"
    CmbBulan.List(1) = "Februari"
    CmbBulan.List(2) = "Maret"
    CmbBulan.List(3) = "April"
    CmbBulan.List(4) = "Mei"
    CmbBulan.List(5) = "Juni"
    CmbBulan.List(6) = "Juli"
    CmbBulan.List(7) = "Agustus"
    CmbBulan.List(8) = "September"
    CmbBulan.List(9) = "Oktober"
    CmbBulan.List(10) = "November"
    CmbBulan.List(11) = "Desember"
End Sub

Private Sub Combo_Tahun_Load()
    Dim i As Integer
    For i = 0 To MaxTahun - MinTahun
        CmbTahun.List(i) = i + MinTahun
    Next
End Sub


Private Sub Grid_Kalender_Load()
    Dim i As Integer
    CalGrid.Row = 0
    CalGrid.Col = 0
    CalGrid.CellAlignment = 4
    CalGrid.CellFontBold = True
    CalGrid.CellBackColor = &HC0C0FF
    
    For i = 1 To 6
        CalGrid.Row = 0
        CalGrid.Col = i
        CalGrid.CellAlignment = 4
        CalGrid.CellFontBold = True
        CalGrid.CellBackColor = &HD4D4D4
    Next
    
    CalGrid.TextMatrix(0, 0) = "Min"
    CalGrid.TextMatrix(0, 1) = "Sen"
    CalGrid.TextMatrix(0, 2) = "Sel"
    CalGrid.TextMatrix(0, 3) = "Rab"
    CalGrid.TextMatrix(0, 4) = "Kam"
    CalGrid.TextMatrix(0, 5) = "Jum"
    CalGrid.TextMatrix(0, 6) = "Sab"

End Sub
Private Sub TampilkanTanggal()
    Dim BanyakTanggal As Integer
    Dim TahunTampil As Integer
    Dim CekKabisat As Boolean
    Dim HariPertama As Integer
    Dim BulanTampil As Integer
    Dim a As Long
    Dim b As Long
    Dim i As Integer
    
     'tanggal hari ini
    TanggalSekarang = Now
    TanggalSekarang = Day(TanggalSekarang)
    
    'hapus tanggal lama
    For a = 1 To 6
        For b = 0 To 6
            CalGrid.Row = a
            CalGrid.Col = b
            CalGrid.Clear
        Next b
    Next a
    
    'inisiasi
    Grid_Kalender_Load
    BulanTampil = CmbBulan.ListIndex + 1
    TahunTampil = CmbTahun.ListIndex + MinTahun
    HariPertama = Program_HariPertama(BulanTampil, TahunTampil)
    CekKabisat = Program_CekKabisat(TahunTampil)
   
    If BulanTampil = 4 Or BulanTampil = 6 Or BulanTampil = 9 Or BulanTampil = 11 Then
        BanyakTanggal = 30
    ElseIf (BulanTampil = 2 And CekKabisat = True) Then
        BanyakTanggal = 29
    ElseIf (BulanTampil = 2 And CekKabisat = False) Then
        BanyakTanggal = 28
    Else
        BanyakTanggal = 31
    End If
    
    'cari hari pertama jawa kabisat
    Dim HariPertamaJawa As Integer
    Dim HariJawa As Integer
    Dim TahunTampil_temp As Integer
    
    If (TahunTampil > 2000) Then
        TahunTampil_temp = TahunTampil - 100
    Else
        TahunTampil_temp = TahunTampil
    End If
    
    
    If (CekKabisat = True) Then
        HariPertamaJawa = Program_HariJawaKabisat(BulanTampil, TahunTampil_temp)
    Else
        HariPertamaJawa = Program_HariJawaBiasa(BulanTampil, TahunTampil_temp)
    End If
    
                      
    'menuliskan tanggal
    HariJawa = HariPertamaJawa
    a = 1
    b = HariPertama - 1
    For i = 1 To BanyakTanggal
        CalGrid.Row = a
        CalGrid.Col = b
        CalGrid.CellAlignment = 4
        CalGrid.WordWrap = True
        
        If (HariIni = True And i = TanggalSekarang) Then
            CalGrid.CellBackColor = &HE0E0E0
            TextTanggalSekarang = GetNamaHari(b + 1) & " " & NamaJawa(HariJawa) & "," & i & " " & CmbBulan.List(CmbBulan.ListIndex) & " " & TahunTampil
        End If
                
        CalGrid.Text = i & vbNewLine & NamaJawa(HariJawa)
        
        If (HariJawa = 5) Then
            HariJawa = 1
        Else
            HariJawa = HariJawa + 1
        End If
                
        If (b = 6) Then
            a = a + 1
            b = -1
        End If
        b = b + 1
    Next
    
    HariIni = False
    
End Sub


Private Sub SysTrayBtn_Click()
    Me.Hide
    Dim nid As NOTIFYICONDATA

    With nid
    .cbSize = Len(nid)
    .hWnd = FormMain.hWnd
    .uID = 0
    .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
    .uCallbackMessage = 1400
    .hIcon = FormMain.Icon
    .szTip = TextTanggalSekarang & vbNullChar

    End With
    Shell_NotifyIconA NIM_ADD, nid
    oldproc = SetWindowLongA(Me.hWnd, -4, AddressOf proc)
    Me.Hide
End Sub

Private Sub Form_Paint()
  formloaded = True
End Sub
Private Sub KalenderTray_Click()
    Dim nid As NOTIFYICONDATA

    With nid

    .hWnd = Me.hWnd
    .cbSize = Len(nid)
    .uID = 0
    End With
  
    Shell_NotifyIconA NIM_DELETE, nid
  
    SetWindowLongA Me.hWnd, -4, oldproc
      
    Me.Show
    Form_Load
End Sub

Private Sub Timer1_Timer()
shari = ahari(Abs(Weekday(Date) - 1))
Label5(1).Caption = "" & shari & ", " & Format(Date, "dd mmmm yyyy")
Label4(1).Caption = Format(Time, "hh:mm:ss")
End Sub

'Module1
--------

Function Program_CekKabisat(TahunTampil As Integer) As Boolean
Dim ModHasil As Integer
Dim CekKabisat As Boolean

ModHasil = TahunTampil Mod 4
   If ModHasil = 0 Then
        ModHasil = TahunTampil Mod 100
        If ModHasil = 0 Then
                ModHasil = TahunTampil Mod 400
                If ModHasil = 0 Then
                    CekKabisat = True
                Else
                    CekKabisat = False
                End If
        Else
             CekKabisat = True
        End If
    Else
        CekKabisat = False
    End If
    
    Program_CekKabisat = CekKabisat
    
End Function

Function Program_HariPertama(BulanTampil As Integer, TahunTampil As Integer) As Integer

Dim TanggalPertama As Date
TanggalPertama = CDate(Format(BulanTampil & "/01/" & TahunTampil, "mm/dd/yyyy"))
Program_HariPertama = Weekday(TanggalPertama)

End Function

Function Program_HariJawaKabisat(BulanTampil As Integer, TahunTampil As Integer) As Integer
    Dim ModHasil As Integer
    Dim JanKabisat As Integer
    ModHasil = TahunTampil Mod 5
    
    If (ModHasil = 0) Then
        JanKabisat = 1
    End If
    
    If (ModHasil = 4) Then
        JanKabisat = 2
    End If
    
    If (ModHasil = 3) Then
        JanKabisat = 3
    End If
    
    If (ModHasil = 2) Then
        JanKabisat = 4
    End If
    
    If (ModHasil = 1) Then
        JanKabisat = 5
    End If
    
    If (BulanTampil = 1) Then
        Program_HariJawaKabisat = JanKabisat
    End If
    
    Dim i As Integer
    Dim jumlah As Integer
    Dim BanyakTanggal As Integer
    jumlah = 0
    If (BulanTampil > 1) Then
        For i = 1 To BulanTampil - 1
            If i = 4 Or i = 6 Or i = 9 Or i = 11 Then
                BanyakTanggal = 30
            ElseIf (i = 2) Then
                BanyakTanggal = 29
            Else
                BanyakTanggal = 31
            End If
            jumlah = jumlah + BanyakTanggal
        Next i
       
        ModHasil = jumlah Mod 5
        
        Program_HariJawaKabisat = ModHasil + JanKabisat
        If (Program_HariJawaKabisat > 5) Then
            Program_HariJawaKabisat = Program_HariJawaKabisat - 5
        End If
    End If
    
End Function

Function NamaJawa(hari As Integer) As String
    If (hari = 1) Then NamaJawa = "Legi"
    If (hari = 2) Then NamaJawa = "Pahing"
    If (hari = 3) Then NamaJawa = "Pon"
    If (hari = 4) Then NamaJawa = "Wage"
    If (hari = 5) Then NamaJawa = "Kliwon"
End Function

Function Program_HariJawaBiasa(BulanTampil As Integer, TahunTampil As Integer) As Integer
    Dim i As Integer
    Dim a As Boolean
    Dim JanKabisat
    
    For i = 1 To 3
        a = Program_CekKabisat(TahunTampil + i)
        If (a = True) Then
            JanKabisat = Program_HariJawaKabisat(1, TahunTampil + i)
            Exit For
        End If
    Next
    
    If (BulanTampil = 1) Then
        Program_HariJawaBiasa = JanKabisat
    End If
    
    Dim jumlah As Integer
    Dim BanyakTanggal As Integer
    jumlah = 0
    If (BulanTampil > 1) Then
        For i = 1 To BulanTampil - 1
            If i = 4 Or i = 6 Or i = 9 Or i = 11 Then
                BanyakTanggal = 30
            ElseIf (i = 2) Then
                BanyakTanggal = 28
            Else
                BanyakTanggal = 31
            End If
            jumlah = jumlah + BanyakTanggal
        Next i
       
        ModHasil = jumlah Mod 5
        
        Program_HariJawaBiasa = ModHasil + JanKabisat
        If (Program_HariJawaBiasa > 5) Then
            Program_HariJawaBiasa = Program_HariJawaBiasa - 5
        End If
    End If
    
    
End Function

Function GetNamaHari(hari As Integer) As String
    If (hari = 1) Then GetNamaHari = "Minggu"
    If (hari = 2) Then GetNamaHari = "Senin"
    If (hari = 3) Then GetNamaHari = "Selasa"
    If (hari = 4) Then GetNamaHari = "Rabu"
    If (hari = 5) Then GetNamaHari = "Kamis"
    If (hari = 6) Then GetNamaHari = "Jumat"
    If (hari = 7) Then GetNamaHari = "Sabtu"
End Function

'Sys Try
----------

Public Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function Shell_NotifyIconA Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Type NOTIFYICONDATA

  cbSize As Long
  hWnd As Long
  uID As Long
  uFlags As Long
  uCallbackMessage As Long
  hIcon As Long
  szTip As String * 64

End Type

Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4

Public formloaded As Boolean
Public oldproc As Long

Public Function proc&(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)

  ' right button release on the icon
  ' so pop up a menu
  ' change 517 to:
  ' 516 --- right button down
  ' 518 --- right button double click
  ' 513 -- left button down
  ' 514 -- left button up
  ' 515 -- left button double click
  ' 519 -- middle button down ( for some mouse only )
  ' 520 -- middle button up
  ' 521 -- middle button double click
     
  If Msg = 1400 And (lParam = 517 Or lParam = 515) And formloaded Then FormMain.PopupMenu FormMain.mnu

  proc = CallWindowProcA(oldproc, hWnd, Msg, wParam, lParam)

End Function

Re: Hello All, need help to SET 5 days in a weeks in VB 2010 EXPRESS

Bernhard Hiller1-Apr-13 22:47

Bernhard Hiller

1-Apr-13 22:47

Do you try to calculate the name of the day both in Bahasa Indonesia and in the Javanese Pasaran cycle?
For the 7 day week of Bahasa Indonesia, you should use the DayOfWeek property of a DateTime object.
The Javanese Pasaran week is different. You need to get the number of days since some minimum date, and then get the remainder of division by 5, that translates then to the Pasaran cycle.
That means: write your application from scratch, get rid of the old VB6 code.

Re: Hello All, need help to SET 5 days in a weeks in VB 2010 EXPRESS

Yazid Aura Robbani2-Apr-13 8:53

Yazid Aura Robbani

2-Apr-13 8:53

Hi Bernarad
Thanks a lot to answering my questions.

I newbie in VB 2010, and that is my problem Big Grin | :-D

After analyzing and comparing; i see so many difference language between VB6 and VB2010. That's why i agree with your opinion about "get rid of the old vb6 code" and write my application from scratch.

Would be more grateful, if you are willing to give me some examples about; dayOfWeek property and a DateTime object in VB 2010.

Regards

(annoergenetica@live.com)

Re: Hello All, need help to SET 5 days in a weeks in VB 2010 EXPRESS

Maciej Los10-Apr-13 3:33

Maciej Los

10-Apr-13 3:33

And your question is...

Re: Hello All, need help to SET 5 days in a weeks in VB 2010 EXPRESS

Yazid Aura Robbani10-Apr-13 11:16

Yazid Aura Robbani

10-Apr-13 11:16

How to set

Day1 As Legi
Day2 As Pahing
Day3 As Pon
Day4 As Wage
Day5 As Kliwon

Day6 = back to Legi
Day7 As pahing
Day8 As Pon
and so on......

[SOLVED] Word 2010 VBA - reading classical wordarts

Bart Van Eyndhoven1-Apr-13 21:58

1-Apr-13 21:58

Hi guys,

I'm developping a Word 2010 macro to get an extended wordcount.

Briefly said, the word macro needs to do 2 things: gather wordcount stats, but including and excluding hidden text and get seperate word counts for texts in main body, headers & footers, shapes, ...

Detailed statistics would be saved to a new Word document. Lay-out etc would be no problem.

There is however a big issue. A lot of the documents that has to be processed are made with Word 2007 or even Word 2003 and earlier. When these documents contain (classic) Word Arts, I can't detect them (they're not in ActiveDocument.Shapes).

How do I:
* read the text from the Word Art?
* take a wordcount from the Word Art text (everything else uses Range.ComputeStatistics(), so I would like to use it as well - eventually creating a temporary range)
* copy the Word Art document to the new document, adding a reference to the page it is on (something like "Word Art on page 5)?

Thanks in advance you guys Smile | :)

Cheers!

modified 8-Apr-13 3:52am.

Kenneth Haugland2-Apr-13 9:19

2-Apr-13 9:19

This sounds very complicated, and I have managed to access shapes in both 2007 and 2003 version before, but I dont think that would help you much.

I think it would be better if you asked this question on the VSTO forum over at microsoft. http://social.msdn.microsoft.com/Forums/en-US/vsto/[^]. They are regularly responded by MVP in the Office interop area.

Bart Van Eyndhoven2-Apr-13 21:25

2-Apr-13 21:25

Hi Kenneth,

First of all: thanks for replying to my question.

I had some kind of feeling this wouldn't be just about having to use another method or something like that.

I've posted my question on the VSTO forum, hope to get an answer too. I'll keep you posted, but in the meanwhile, I'll provide the link to the thread here: http://social.msdn.microsoft.com/Forums/en-US/vsto/thread/382419a7-bd30-471d-b285-8b0959340bba

Cheers

Bart Van Eyndhoven7-Apr-13 21:52

7-Apr-13 21:52

Hi,

Got the andwer Smile | :)

I had to loop through the InlineShapes collection.

dim ishp as InlineShape

For Each ishp in ActiveDocument.InlineShapes
    If ishp.Type = 3 Then
        'Handle text by using ishp.TextEffect.Text
    End If
Next

Cheers!

Kenneth Haugland7-Apr-13 23:02

7-Apr-13 23:02

Brilliant, It is not easy finding out things like that, I appriciate your effort Smile | :)

Edit:
MEaning some time in the future you will save me a lot of hours.

modified 8-Apr-13 5:52am.

Bart Van Eyndhoven8-Apr-13 22:19

Editable Grid for Windows 7 (32 or 64 bit)

8-Apr-13 22:19

Probably

That's why I shared the answer Smile | :)

Cheers!

Mybase.New problem

Christoffer Svensson31-Mar-13 6:42

Christoffer Svensson

31-Mar-13 6:42

Hey Im having a problem with my calendar project and cant get my Mybase.new to work. This project is way over my competence and would be very greatful if someone could take a look at it.

Public Sub New(ByVal calendar As Calendar)
MyBase.New(calendar) <-------

_topsPassing = New List(Of CalendarDayTop)()
_backgroundColor = Color.Empty
_borderColor = Color.Empty
_oreColor = Color.Empty
_backgroundColorLighter = Color.Empty

End Sub

Im getting the error "Value of type 'WindowsApplication1.Calendar' cannot be converted to 'System.Windows.Forms.Calendar.Calendar"

The project is quite big so the problem might be somewhere else. I uploaded it on speedyshare if someone got the time, I would really appreciate some help.

http://speedy.sh/sYRjS/ProjArbete4.zip[^]

Regards Christoffer

Re: Mybase.New problem

Dave Kreskowiak31-Mar-13 7:11

Dave Kreskowiak

31-Mar-13 7:11

You're trying to pass your Calendar class in the place of what your base class is expecting, a System.Windows.Forms.Calendar.Calendar. The two are not interchangable as it's saying that your Calendar class did not inherit from System.Windows.Forms.Calendar.Calendar.

You have to pass in a System.Windows.Forms.Calendar.Calendar, or something that derives from it.

A guide to posting questions on CodeProject[^]

Dave Kreskowiak

h0k3n931-Mar-13 6:12

h0k3n9

31-Mar-13 6:12

Hi all Master VB6, someone can help me, please...

I need source code or ocx (free) for EditableGrid, our customer need input detail trx in editable grid, and easy to use.

And will be running on Windows 7 (32 or 64 bit).

Thanks before

Dave Kreskowiak31-Mar-13 7:09

Dave Kreskowiak

31-Mar-13 7:09

Why on this earth are you doing new development in VB6?? It's dead and has been for quite a long time now.

A guide to posting questions on CodeProject[^]

Dave Kreskowiak

h0k3n931-Mar-13 15:10

h0k3n9

31-Mar-13 15:10

Because vb6 has help me to get jobs and get money from it and have value for me, not mean we should forget it.

I create project with vb6 for small project, but now I am focus to the web programming like dot net and php.

May be another person can help me, please.

Thank you

Dave Kreskowiak31-Mar-13 15:14

Dave Kreskowiak

31-Mar-13 15:14

Good luck! Industry support for controls for VB6 is just about completely gone.

A guide to posting questions on CodeProject[^]

Dave Kreskowiak