nighttrain's Profile User Rating: -----

Reputation: 5 Worker
Group:
Active Members
Active Posts:
295 (0.21 per day)
Joined:
22-September 10
Profile Views:
4,215
Last Active:
User is offline Today, 12:27 PM
Currently:
Offline

Previous Fields

Country:
PL
OS Preference:
Windows
Favorite Browser:
Chrome
Favorite Processor:
Intel
Favorite Gaming Platform:
PC
Your Car:
Volkswagen
Dream Kudos:
0
Icon   nighttrain still drilling

Posts I've Made

  1. In Topic: Application OOP structure to check

    Posted 16 Aug 2014

    can anyone check it?
  2. In Topic: Application OOP structure to check

    Posted 15 Aug 2014

    could you check class diagram according to my code is it correctly related to my code its my first class diagram and want to know if its done correctly:
    https://www.dropbox....i8ma2jj65/1.png
  3. In Topic: Application OOP structure to check

    Posted 7 Aug 2014

    hi skydiver thanks for your feedback what in case of relationshipis between clsses are they ok?
  4. In Topic: Application OOP structure to check

    Posted 6 Aug 2014

    any feedback?
  5. In Topic: VBA Compare between excel and word

    Posted 22 May 2014

    any feedback on that? This is my code so far but i still have no idea how to program that:
    Sub Sprawdz_Pola_Korespondencji_Click()
    
    Application.ScreenUpdating = True
    
    Dim RowNr As Integer
    Dim EWS As Worksheet
    
    RowNr = 30
    Set EWS = Sheets("Arkusz do wypełnienia")
    
    
    Dim FileName As Variant, wb As Workbook
    FileName = Application.GetOpenFilename(FileFilter:="Word File (*.docx),*.docx", Title:="Select File To Be Opened")
    If FileName = False Then Exit Sub
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    
    Set WordDoc = WordApp.Documents.Open(FileName)
    Dim p As Paragraph
    Dim PoleWorld As String
    
    
    Dim ExcelField As String
    Dim WordField As String
    
    X = 1
    
    Do
            ExcelField = ""
            X = X + 1
            ExcelField = EWS.Cells(RowNr, X)
            
            If ExcelField <> "" Then
            
            ExcelField = ReplaceChars(ExcelField) ' zamiana spacji na _
    
                If ExcelField = "KONIEC" Then Exit Do
                    
                    For Each p In WordDoc.Paragraphs
                    
                        WordField = CStr(p.Range.Text)
                        WordField = Replace(WordField, Chr(13), "")
                    
                        'Check WordFile is not empty and start with «
                        If (WordField <> "" And WordField Like "*«*") Then   'sometimes in Excel columns are nulls we go next
                                                              
                          WordField = removeSpecial(WordField)
                                                     
                          '  If InStr(ExcelField, removeSpecial(WordField)) > 0 Then
                                               
                            'Instr(string to be searched, string to find)
                            'If string contains removeSpecial(WordField) (start searching from 1st letter
    
    'If (ExcelField Like WordField & "*" Or InStr(ExcelField, WordField) Or WordField Like ExcelField & "*") Then
                            If (InStr(ExcelField, WordField)) Then
                            'If InStr(ExcelField, WordField) Then
                            
                                        Excel3LiteryOdLewej = Mid(ExcelField, 1, 9)
                                        Word3LiteryOdLewej = Mid(WordField, 1, 9)
                            
                                    If Excel3LiteryOdLewej = Word3LiteryOdLewej Then
                            
                                        EWS.Cells(5, X).Interior.ColorIndex = 4
                                        Exit For 'field found in word exit and next
                                    Else
                                        EWS.Cells(5, X).Interior.ColorIndex = 3
                                    End If
                            
                            Else
                            
                            EWS.Cells(5, X).Interior.ColorIndex = 3
                            
                           
                            End If
                            
                            
                        End If
                        
                    Next p
                    
            End If
    
    Loop Until EWS.Cells(RowNr, X) = "KONIEC"
    
    WordDoc.Close savechanges:=False 'or false
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
    
    
    'Dim rngParagraphs As Range
    'Set rngParagraphs = Activedocument.Range(Start:=Activedocument.Paragraphs(1).Range.Start, End:=Activedocument.Paragraphs(4).Range.End)
    'rngParagraphs.Select
        
    
    'ngParagraphs.Find.Text = "Contoso"
    'rngParagraphs.Find.Forward = True
    'rngParagraphs.Find.MatchWholeWord = True
    
    'If rngParagraphs.Find.Execute Then
     '   Wscript.Echo "The search text was found."
    'Else
        'Wscript.Echo "The search text was not found."
    'End If
    
    End Sub
    
    Function FindString(strCheck As String, strFind As String) As Boolean
    
        intPos = 0
    
        intPos = InStr(strCheck, strFind)
    
        FindString = intPos > 0
    
    End Function
    
    Function ReplaceChars(strInput As String) As String
    
    
        'Function to replace chars because word series corespondention converting it to _
        Public Function ReplaceChars(strInput As String) As String
        ' Replacesspaces in a string of text with underscores
        Dim Result As String
        Result = strInput
        
        Result = Replace(strInput, " ", "_")
        Result = Replace(Result, Chr(40), "_")   ' (
        Result = Replace(Result, Chr(41), "_")  ' )
        Result = Replace(Result, Chr(45), "")  ' )
        Result = Replace(Result, Chr(46), "")  ' )
        Result = Replace(Result, Chr(44), "")  ' )
        
        
        'jak zostanie jakas spacja to usun
        Result = Replace(strInput, " ", "")
           'If InStr(strInput, " ") > 0 Then
           ' Result = Replace(strInput, " ", "_")
           'End If
        
        'if it returns anything other than zero, the string is found.
        
        Dim Bool_input As Boolean
        
        Bool_input = InStr(Result, "__") <> 0
        If Bool_input = True Then
            Result = Replace(Result, "__", "_")  '
        End If
        
        
        'aby wyeliminowac _ na kocnu stringa w Excel field
        a = 0
        Do While Right(Result, 1) = "_"
        Result = Left(Result, Len(Result) - 1)
        a = a + 1
        Loop
        
        
         ReplaceChars = Result
        
        End Function
    
    
    Function removeSpecial(sInput As String) As String
        Dim sSpecialChars As String
        Dim i As Long
        sSpecialChars = "\/:*?™""®<>|.&@# (+`©~);-+=^$«»!,'" 'This is your list of characters to be removed
        For i = 1 To Len(sSpecialChars)
            sInput = Replace$(sInput, Mid$(sSpecialChars, i, 1), " ") 'if "" - this will remove spaces
        Next
           
    Dim a As Integer
    Do While Left(sInput, 1) = " "
         sInput = Mid(sInput, 2)
    a = a + 1
    Loop
     
       
    a = 0
    Do While Right(sInput, 1) = " "
        sInput = Left(sInput, Len(sInput) - 1)
    a = a + 1
    Loop
    
    removeSpecial = sInput
    End Function
    
    
    


    the most important line:
     If (InStr(ExcelField, WordField)) Then
    
    

My Information

Member Title:
D.I.C Regular
Age:
Age Unknown
Birthday:
Birthday Unknown
Gender:
Location:
Poland
Full Name:
Bob
Years Programming:
4
Programming Languages:
VB,NET, C++, C#, PHP, HTML, JS, CSS, Pascal,

Contact Information

E-mail:
Click here to e-mail me
ICQ:
ICQ  637172526

Friends

Comments

Page 1 of 1
  1. Photo

    FlashM Icon

    24 Sep 2010 - 14:17
    no problem... you're welcome anytime...
Page 1 of 1