Spreadsheet

Le 21/07/2009 à 17:59

Bonjour , avis aux spécialistes du VBA je joint un fichier sur lequel je voudrais inscrire les modifications faite dans les Textbox sur le Spreadsheet et lors du clic sur validation dans les cellules du tableau de la feuille1 ?

https://www.excel-pratique.com/~files/doc2/Spreadsheets.xls

Le 21/07/2009 à 18:52

Bonsoir,

dans le code de l'USF, remplace tout ce que tu as par ceci :

 Dim Lig As Long, Ind As Integer
 Dim Valeur

Private Sub CommandButton1_Click()
With Spreadsheet1
    Lig = .ActiveCell.Row
    For Ind = 1 To 9
        If CStr(Me("TextBox" & Ind).Value) <> CStr(.Cells(Lig, Ind)) Then
            Valeur = Me("TextBox" & Ind).Value
            .Cells(Lig, Ind) = Me("TextBox" & Ind).Value
        End If
    Next
End With
End Sub

Private Sub Spreadsheet1_SelectionChange()
With Spreadsheet1
Lig = .ActiveCell.Row
For Ind = 1 To 9
    Me("TextBox" & Ind).Value = .Cells(Lig, Ind)
Next
End With
End Sub

Private Sub Spreadsheet1_SheetChange(ByVal Sh As OWC11.Worksheet, ByVal Target As OWC11.Range)
Range("tab")(Lig, Ind).Value = Valeur
End Sub

Private Sub UserForm_Initialize()
Dim cell As Range
Dim l As Integer
Dim c As Integer
For Each cell In Range("tab")
    l = cell.Row
    c = cell.Column
    With Me.Spreadsheet1.Cells(l - 6, c - 2)
        .Font.Color = cell.Font.Color
        .Font.Bold = cell.Font.Bold
        .Font.Size = cell.Font.Size
        .Value = cell.Value
    End With
Next cell
End Sub
Le 21/07/2009 à 19:00

Re-,

Euh, sous condition que tu as bien Excel 2003....

C'est bien, de renseigner la version utilisée dans son profil.....(voire indispensable, les réponses s'adaptant à la version....)

Et en complément, c'est très bien aussi, de donner une suite lorsque l'on a une réponse, du style "Merci"

Ref :

https://forum.excel-pratique.com/viewtopic.php?p=2920&highlight=#2920

Le 21/07/2009 à 19:41

Merci pour votre rapidité.

Je vais l'adapter sur mon classeur .

Comment mettre ce sujet en Résolu ?

Le 21/07/2009 à 19:47

Re,

juste avant de mettre en résolu, pense à renseigner ta version d'Excel...

pour mettre en résolu, regarde ce fil

https://forum.excel-pratique.com/viewtopic.php?t=13

Tout est expliqué....

PS, ça fonctionne?

Car tu remercies, mais tu ne dis pas si cela fonctionne

Un forum est un lieu d'échanges, et cela doit profiter à tout le monde....

Bonne soirée

Le 22/07/2009 à 02:28

Re-,

Ascal......

Comme ton pseudo finit par 44...

Tu ne vas quand même pas confirmer que tous les 44 sont Ainsi :

https://forum.excel-pratique.com/viewtopic.php?t=12466&sid=d2c4e8bc7c8c359b23e4d9ece4254bc3

C'est grave, alors....

J'ai juste demandé :

  • que tu mettes à jour ton Pseudo (fait)
  • que tu dises si la solution proposée fonctionne (En Attente)

Bref, désormais, je me méfierai des Pseudos terminant par 44 (pour un breton comme moi, ça me fait mal........)

Le 22/07/2009 à 19:13

Bonsoir , faut pas faire des généralités sur les 44 : Suis je breton ? Je suis situé sud Loire. je serait fier de l'être.

Mais je suis certainement têtu comme un Breton c'est pour cela que ma réponse se fait attendre.

J'ai essayé (sans succès , je ne suis pas aussi intelligent qu'un Breton) de comprendre le Bug que j'ai sur mon classeur d'origine :

Erreur de compilation

Type défini par l'utilisateur non défini.

Sur ce code :

Private Sub Spreadsheet1_SheetChange(ByVal Sh As OWC11.Worksheet, ByVal Target As OWC11.Range)

Range("tableau")(Lig, Ind).Value = Valeur

End Sub

Voici la totalité du code :

Dim Lig As Long, Ind As Integer

Dim Valeur

Private Sub Spreadsheet1_SheetChange(ByVal Sh As OWC11.Worksheet, ByVal Target As OWC11.Range)

Range("tableau")(Lig, Ind).Value = Valeur

End Sub

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

With Spreadsheet1

Lig = .ActiveCell.Row

For Ind = 2 To 25

If CStr(Me("TextBox" & Ind).Value) <> CStr(.Cells(Lig, Ind)) Then

Valeur = Me("TextBox" & Ind).Value

.Cells(Lig, Ind) = Me("TextBox" & Ind).Value

End If

Next

End With

Dim DERLIGNE As Long, X

Dim Ws As Worksheet

Dim LASTLIG As Integer

For Each Ws In Sheets(Array("consommé"))

With Sheets("consommé")

DERLIGNE = Ws.Range("A65536").End(xlUp).Row + 1

Ws.Range("A" & DERLIGNE) = Txtdate

Ws.Range("B" & DERLIGNE) = TextBox2.Value ' Région

Ws.Range("C" & DERLIGNE) = TextBox3.Value 'Appellation

Ws.Range("D" & DERLIGNE) = TextBox4.Value 'Proprietes

Ws.Range("E" & DERLIGNE) = TextBox5.Value 'Millesime

Ws.Range("F" & DERLIGNE) = TextBox6.Value 'Medaille

Ws.Range("G" & DERLIGNE) = TextBox7.Value 'Apogee

Ws.Range("H" & DERLIGNE) = TextBox22.Value ' Prix

Ws.Range("I" & DERLIGNE) = TextBox1.Value 'Remarque

End With

Next

'If Place <> "" Then Sheets("CAVE").Range("U" & Proprietes.ListIndex + 5) = Trim(Place.Value)

TextBox2.Value = "" ' Région

TextBox3.Value = "" 'Appellation

TextBox4.Value = "" 'Proprietes

TextBox5.Value = "" 'Millesime

TextBox6.Value = "" 'Medaille

TextBox7.Value = "" 'Apogee

TextBox22.Value = "" ' Prix

TextBox1.Value = "" 'Remarque

Range("AB5:AZ200").ClearContents

If Range("T65536").End(xlUp).Row > 4 Then Range("T4:T200" & Range("T65536").End(xlUp).Row).ClearContents

col = 28

ligne = 5

For n = 5 To Range("U65536").End(xlUp).Row

X = Split(Range("U" & n), " ")

Cells(ligne, 20) = UBound(X) + 1

For M = 0 To UBound(X)

Cells(ligne, col + M) = X(M)

Next M

ligne = ligne + 1

Next n

End Sub

Private Sub CommandButton2_Click()

Userform3.Hide

End Sub

Private Sub CommandButton3_Click()

Cal.Show

End Sub

Private Sub TextBox1_Change()

Static point As Boolean

Dim der As String

der = Right(TextBox1, 1)

If Len(TextBox1) = 1 Or InStr(".:!?+&", der) Then point = True

If point And InStr(" .:!?+&", der) = 0 Then

TextBox1 = Application.Replace(TextBox1, Len(TextBox1), 1, UCase(der))

point = False

End If

End Sub

Private Sub Spreadsheet1_SelectionChange()

Dim Lig As Long, Ind As Integer

With Spreadsheet1

Lig = .ActiveCell.Row

For Ind = 2 To 25

Me("TextBox" & Ind).Value = .Cells(Lig, Ind)

Next

End With

End Sub

Private Sub UserForm_Initialize()

Txtdate = Format(Date, "dd/mm/yy")

Dim cell As Range

Dim l As Integer

Dim c As Integer

For Each cell In Range("tableau")

l = cell.Row

c = cell.Column

With Me.Spreadsheet1.Cells(l - 3, c - 0)

.Font.Color = cell.Font.Color

.Font.Bold = cell.Font.Bold

.Font.Size = cell.Font.Size

.Value = cell.Value

End With

Next cell

End Sub

Je me soumet encore à votre savoir

Le 24/07/2009 à 17:34

Bonjour , j'ai résolu le problème d'adaptation du code en supprimant le Spreadsheet d'origine et en créant un de nouveau.

Je pense que j'avais due mettre de mauvais paramètres dans mon premier Spraedsheet qui bloquait le code.

Vous voyez que les nantais sont aussi têtus que les Bretons

Rechercher des sujets similaires à "spreadsheet"