Problem with my final macro (MVP help please) 
Author Message
 Problem with my final macro (MVP help please)

Hi Angela,

Quote:
> 1) Insert a company header on each page using a link rather than an
> image insert. That way if the image changes all old and new documents
> that are created will have the new logo when printed

Have you considered inserting it once - in the document's header?

You can insert a linked picture, inline, using something like:

    ActiveDocument.InlineShapes.AddPicture _
        Filename:="The path", _
       LinkToFile:=True, _
Range:=ActiveDocument.Sections(1).Headers(wdHeaderFooterprimary).Range

Cindy Meister
INTER-Solutions, Switzerland
http://www.*-*-*.com/
http://www.*-*-*.com/

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail :-)



Tue, 19 Nov 2002 03:00:00 GMT  
 Problem with my final macro (MVP help please)
Hi Angela.

I just worked on a tiny bit of your code... the part that checks for letters
in the last 6 places of the medical record number.  This does find the
error.

'Check characters 2 to 7
      For i = 1 To 6
        'Test to see if the character is NOT a number
        If Right(HospNumber, i) Like "[!0-9]" Then
          entryWrong = True
        End If
      Next i
        GoTo RightNumber

This finds the wrong number, but it doesn't then call the wrong number
routine.  If that's what you want, then it should look like this, I think

'Check characters 2 to 7
      For i = 1 To 6
        'Test to see if the character is NOT a number
        If Right(HospNumber, i) Like "[!0-9]" Then
          entryWrong = True
        End If
      Next i
        If entryWrong = True then
            GoTo WrongNumber
        Else
            GoTo RightNumber
        End If

I'm no expert for sure.  Just trying to give some help back for a change.

Marianne DeLavan Johnson


Quote:
> Dear All
> With the help of this newsgroup I managed to get the folowing MACRO to
> work.

> It has been working quite well an I now have most people using it. The
> only problem that has never really been looked at is the part that
> does the error checking.

> It works in that it does not allow the user to enter more than 7
> characters. And it only allows certain characters to be entered at the
> begining. The problem is that there is part that checks for letters in
> the 7 characters does not seem to work.

> ie.
> B555f44
> E333fg3

> is allowed.. Can anyone work out what is going wrong ?

> In addition I need to modify/create a macro that will

> 1) Insert a company header on each page using a link rather than an
> image insert. That way if the image changes all old and new documents
> that are created will have the new logo when printed

> I am not too bothered about the image at the moment. Just really
> looking for someone who may have done this before. The main reason for
> this post is to fix the code

> Thanks in advance. Others who have found this code please feel free to
> steal it and modify it.

> Sub Hospital_Filing()
> Dim HospNumber, Location, Folder, Root, mynum, strPath As String
> Dim entryWrong As Boolean
> entryWrong = True
> Do
> ' The below line asks for the hospital number
> ' The code check for user errors in the hospital number
> ' But it cannot help if they type the wrong number
> HospNumber = InputBox("Please enter the Hospital Number.
> OK to accept. CANCEL to continue", , HospNumber)
> HospNumber = UCase(HospNumber)
> If HospNumber <> "" Then
>   If Len(HospNumber) = 7 Then
>     'Check first character to see if it is NOT E or B or F or P
>     If Left(HospNumber, 1) Like "[!EBFP]" Then
>         GoTo WrongNumber
>     Else
>       'Check characters 2 to 7
>       For i = 2 To 7
>         'Test to see if the character is NOT a number
>         If Mid(HospNumber, i, 1) Like "[!0-9]" Then
>           entryWrong = True
>         End If
>       Next i
>         GoTo RightNumber
>     End If
>   Else
>     'Length <> 7
>     GoTo WrongNumber
>   End If
> Else
>   'Cancel or no input
>   'MsgBox "User pressed cancel"
>   Exit Sub
> End If
> WrongNumber:
>   MsgBox "This is not a valid number. Please check and type again",
> 64, HospNumber
> Loop While entryWrong

> RightNumber: 'This is the main processing part of the code
> Location = Left(HospNumber, 1) ' Extracts E, B, F and P
> Folder = Location + Mid(HospNumber, 6, 1) + "0" ' Take the range eg 2
> for 22 and then adds a 0
> Root = "e:\respsec\" 'Sets the location of where the Hospital Files
> are kept

> If Location = "B" Then FullLocal = "Barnet"
> If Location = "E" Then FullLocal = "Edgware"
> If Location = "F" Then FullLocal = "fmhpbh"
> If Location = "P" Then FullLocal = "fmhpbh"

> If Location = "P" Then
>     If Len(Dir(Root + FullLocal + "\" + HospNumber + ".doc")) > 0 Then
>     MsgBox ("The File " + HospNumber + ".DOC " + " already exists.
> Press OK to Open")
>     Documents.Open (Root + FullLocal + "\" + HospNumber + ".doc")
>     Exit Sub
>     End If
> End If

> If Location = "F" Then
>     If Len(Dir(Root + FullLocal + "\" + HospNumber + ".doc")) > 0 Then
>     MsgBox ("The File " + HospNumber + ".DOC " + " already exists.
> Press OK to Open")
>     Documents.Open (Root + FullLocal + "\" + HospNumber + ".doc")
>     Exit Sub
>     End If
> End If

> ' Check to see if there is already a file. If there is OPEN IT.
> If Len(Dir(Root + FullLocal + "\" + Folder + "\" + HospNumber +
> ".doc")) > 0 Then
>     MsgBox ("The File " + HospNumber + ".DOC " + " already exists.
> Press OK to Open")
>     Documents.Open (Root + FullLocal + "\" + Folder + "\" + HospNumber
> + ".doc")
>     Exit Sub
>     End
> Else
> End If
> ' Before creating a new file it checks with the user
> Response = MsgBox("The File " + HospNumber + ".DOC " + " Could not be
> found. Would you like to create it ?", vbYesNo, "Hospital Number")
> If Response = vbYes Then
>     Documents.Add
>     If Location = "F" Then
>       ActiveDocument.SaveAs (Root + FullLocal + "\" + HospNumber +
> ".doc")
>       End
>     End If
>     If Location = "P" Then
>       ActiveDocument.SaveAs (Root + FullLocal + "\" + HospNumber +
> ".doc")
>       End
>     End If
>     ActiveDocument.SaveAs (Root + FullLocal + "\" + Folder + "\" +
> HospNumber + ".doc")
> End If
> ' If the user in sure that the file should be there they choose NO and
> it takes them
> ' into a file open windows in the corect folder.
> If Response = vbNo Then
>  With Dialogs(wdDialogFileOpen)
>     .Name = Root + FullLocal + "\" + Folder + "\"
>     .Show
>  End With
> End If

> End Sub



Tue, 19 Nov 2002 03:00:00 GMT  
 Problem with my final macro (MVP help please)
Dear All
With the help of this newsgroup I managed to get the folowing MACRO to
work.

It has been working quite well an I now have most people using it. The
only problem that has never really been looked at is the part that
does the error checking.

It works in that it does not allow the user to enter more than 7
characters. And it only allows certain characters to be entered at the
begining. The problem is that there is part that checks for letters in
the 7 characters does not seem to work.

ie.
B555f44
E333fg3

is allowed.. Can anyone work out what is going wrong ?

In addition I need to modify/create a macro that will

1) Insert a company header on each page using a link rather than an
image insert. That way if the image changes all old and new documents
that are created will have the new logo when printed

I am not too bothered about the image at the moment. Just really
looking for someone who may have done this before. The main reason for
this post is to fix the code

Thanks in advance. Others who have found this code please feel free to
steal it and modify it.

Sub Hospital_Filing()
Dim HospNumber, Location, Folder, Root, mynum, strPath As String
Dim entryWrong As Boolean
entryWrong = True
Do
' The below line asks for the hospital number
' The code check for user errors in the hospital number
' But it cannot help if they type the wrong number
HospNumber = InputBox("Please enter the Hospital Number.
OK to accept. CANCEL to continue", , HospNumber)
HospNumber = UCase(HospNumber)
If HospNumber <> "" Then
  If Len(HospNumber) = 7 Then
    'Check first character to see if it is NOT E or B or F or P
    If Left(HospNumber, 1) Like "[!EBFP]" Then
        GoTo WrongNumber
    Else
      'Check characters 2 to 7
      For i = 2 To 7
        'Test to see if the character is NOT a number
        If Mid(HospNumber, i, 1) Like "[!0-9]" Then
          entryWrong = True
        End If
      Next i
        GoTo RightNumber
    End If
  Else
    'Length <> 7
    GoTo WrongNumber
  End If
Else
  'Cancel or no input
  'MsgBox "User pressed cancel"
  Exit Sub
End If
WrongNumber:
  MsgBox "This is not a valid number. Please check and type again",
64, HospNumber
Loop While entryWrong
RightNumber: 'This is the main processing part of the code
Location = Left(HospNumber, 1) ' Extracts E, B, F and P
Folder = Location + Mid(HospNumber, 6, 1) + "0" ' Take the range eg 2
for 22 and then adds a 0
Root = "e:\respsec\" 'Sets the location of where the Hospital Files
are kept

If Location = "B" Then FullLocal = "Barnet"
If Location = "E" Then FullLocal = "Edgware"
If Location = "F" Then FullLocal = "fmhpbh"
If Location = "P" Then FullLocal = "fmhpbh"

If Location = "P" Then
    If Len(Dir(Root + FullLocal + "\" + HospNumber + ".doc")) > 0 Then
    MsgBox ("The File " + HospNumber + ".DOC " + " already exists.
Press OK to Open")
    Documents.Open (Root + FullLocal + "\" + HospNumber + ".doc")
    Exit Sub
    End If
End If

If Location = "F" Then
    If Len(Dir(Root + FullLocal + "\" + HospNumber + ".doc")) > 0 Then
    MsgBox ("The File " + HospNumber + ".DOC " + " already exists.
Press OK to Open")
    Documents.Open (Root + FullLocal + "\" + HospNumber + ".doc")
    Exit Sub
    End If
End If

' Check to see if there is already a file. If there is OPEN IT.
If Len(Dir(Root + FullLocal + "\" + Folder + "\" + HospNumber +
".doc")) > 0 Then
    MsgBox ("The File " + HospNumber + ".DOC " + " already exists.
Press OK to Open")
    Documents.Open (Root + FullLocal + "\" + Folder + "\" + HospNumber
+ ".doc")
    Exit Sub
    End
Else
End If
' Before creating a new file it checks with the user
Response = MsgBox("The File " + HospNumber + ".DOC " + " Could not be
found. Would you like to create it ?", vbYesNo, "Hospital Number")
If Response = vbYes Then
    Documents.Add
    If Location = "F" Then
      ActiveDocument.SaveAs (Root + FullLocal + "\" + HospNumber +
".doc")
      End
    End If
    If Location = "P" Then
      ActiveDocument.SaveAs (Root + FullLocal + "\" + HospNumber +
".doc")
      End
    End If
    ActiveDocument.SaveAs (Root + FullLocal + "\" + Folder + "\" +
HospNumber + ".doc")
End If
' If the user in sure that the file should be there they choose NO and
it takes them
' into a file open windows in the corect folder.
If Response = vbNo Then
 With Dialogs(wdDialogFileOpen)
    .Name = Root + FullLocal + "\" + Folder + "\"
    .Show
 End With
End If

End Sub



Wed, 20 Nov 2002 03:00:00 GMT  
 
 [ 3 post ] 

 Relevant Pages 

1. PLEASE HELP, PLEASE HELP, PLEASE HELP, PLEASE HELP, PLEASE HELP, PLEASE HELP, PLEASE HELP,

2. MVP-looking for help with .addnew, Please help!!!

3. MVP-looking for help with .addnew, Please help!!!

4. Visual Basic Final at School...HELP ME PLEASE

5. Urgent ! Final year project- Please Help

6. Visual Basic Final at School...HELP ME PLEASE

7. Visual Basic Final at School...HELP ME PLEASE!

8. Can anyone HELP me PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE

9. Cloning problem -- please please please help

10. PLEASE ALL YOU MVP'S

11. PLEASE READ: MVPS @ Conference 2/10 - 2/12

12. Please STOP MVP McCarthy

 

 
Powered by phpBB® Forum Software